summaryrefslogtreecommitdiff
path: root/Perl-RPM/t/03_errors.t
blob: ca1206267afdbbb2b3f635d2c5d1b0d20827c822 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
#!/usr/bin/perl

# Test the error-reporting and management functions

use RPM::Error;
use RPM::Constants ':rpmerr';

use vars qw($called $string $oldcb);

select(STDOUT); $| = 1;

print "1..9\n";

# tests 1-2: basic set
rpm_error(RPMERR_BADARG, "Bad argument passed");

print 'not ' unless ($RPM::err == RPMERR_BADARG);
print "ok 1\n";

print 'not ' unless ($RPM::err eq 'Bad argument passed');
print "ok 2\n";

# tests 3-4: clearing the values
clear_errors;

print 'not ' if ($RPM::err);
print "ok 3\n";

print 'not ' if (length($RPM::err));
print "ok 4\n";

# tests 5-8: callbacks
$called = 0;
set_error_callback(sub { $called = 1 });
rpm_error(RPMERR_BADSPEC, "Bad spec");

print 'not ' unless ($called);
print "ok 5\n";

sub cb1 { $called = shift; $string = shift; }
$called = 0; $string = '';
set_error_callback('cb1');
rpm_error(RPMERR_BADDEV, "baddev");

print 'not ' unless ($called == $RPM::err);
print "ok 6\n";

print 'not ' unless (length($string) == 6);
print "ok 7\n";

sub cb2 { $called = 1 }
set_error_callback(\&cb2);
rpm_error(RPMERR_BADMAGIC, "badmagic");

print 'not ' unless ($called == 1 and $RPM::err == RPMERR_BADMAGIC);
print "ok 8\n";

set_error_callback(undef);
$called = 0;
rpm_error(RPMERR_BADDEV, "baddev");

print 'not ' if ($called);
print "ok 9\n";

exit 0;