Commit | Line | Data |
809908f7 |
1 | # -*-perl-*- |
2 | use strict; |
3 | use vars qw($Expect); |
711cdd39 |
4 | use Test qw($TESTOUT $TESTERR $ntest ok skip plan); |
809908f7 |
5 | plan tests => 14; |
6 | |
7 | open F, ">fails"; |
8 | $TESTOUT = *F{IO}; |
711cdd39 |
9 | $TESTERR = *F{IO}; |
809908f7 |
10 | |
11 | my $r=0; |
12 | { |
13 | # Shut up deprecated usage warning. |
14 | local $^W = 0; |
15 | $r |= skip(0,0); |
16 | } |
17 | $r |= ok(0); |
18 | $r |= ok(0,1); |
19 | $r |= ok(sub { 1+1 }, 3); |
20 | $r |= ok(sub { 1+1 }, sub { 2 * 0}); |
21 | |
22 | my @list = (0,0); |
23 | $r |= ok @list, 1, "\@list=".join(',',@list); |
24 | $r |= ok @list, 1, sub { "\@list=".join ',',@list }; |
25 | $r |= ok 'segmentation fault', '/bongo/'; |
26 | |
27 | for (1..2) { $r |= ok(0); } |
28 | |
29 | $r |= ok(1, undef); |
30 | $r |= ok(undef, 1); |
31 | |
32 | ok($r); # (failure==success :-) |
33 | |
34 | close F; |
35 | $TESTOUT = *STDOUT{IO}; |
711cdd39 |
36 | $TESTERR = *STDERR{IO}; |
809908f7 |
37 | $ntest = 1; |
38 | |
39 | open F, "fails"; |
40 | my $O; |
41 | while (<F>) { $O .= $_; } |
42 | close F; |
43 | unlink "fails"; |
44 | |
45 | ok join(' ', map { m/(\d+)/; $1 } grep /^not ok/, split /\n+/, $O), |
46 | join(' ', 1..13); |
47 | |
48 | my @got = split /not ok \d+\n/, $O; |
49 | shift @got; |
50 | |
51 | $Expect =~ s/\n+$//; |
52 | my @expect = split /\n\n/, $Expect; |
53 | |
75fa620a |
54 | |
55 | sub commentless { |
56 | my $in = $_[0]; |
57 | $in =~ s/^#[^\n]*\n//mg; |
58 | $in =~ s/\n#[^\n]*$//mg; |
59 | return $in; |
60 | } |
61 | |
62 | |
809908f7 |
63 | for (my $x=0; $x < @got; $x++) { |
75fa620a |
64 | ok commentless($got[$x]), commentless($expect[$x]."\n"); |
809908f7 |
65 | } |
66 | |
67 | |
68 | BEGIN { |
69 | $Expect = <<"EXPECT"; |
711cdd39 |
70 | # Failed test 1 in $0 at line 15 |
809908f7 |
71 | |
711cdd39 |
72 | # Failed test 2 in $0 at line 17 |
809908f7 |
73 | |
711cdd39 |
74 | # Test 3 got: '0' ($0 at line 18) |
809908f7 |
75 | # Expected: '1' |
76 | |
711cdd39 |
77 | # Test 4 got: '2' ($0 at line 19) |
809908f7 |
78 | # Expected: '3' |
79 | |
711cdd39 |
80 | # Test 5 got: '2' ($0 at line 20) |
809908f7 |
81 | # Expected: '0' |
82 | |
711cdd39 |
83 | # Test 6 got: '2' ($0 at line 23) |
809908f7 |
84 | # Expected: '1' (\@list=0,0) |
85 | |
711cdd39 |
86 | # Test 7 got: '2' ($0 at line 24) |
809908f7 |
87 | # Expected: '1' (\@list=0,0) |
88 | |
711cdd39 |
89 | # Test 8 got: 'segmentation fault' ($0 at line 25) |
809908f7 |
90 | # Expected: qr{bongo} |
91 | |
711cdd39 |
92 | # Failed test 9 in $0 at line 27 |
809908f7 |
93 | |
711cdd39 |
94 | # Failed test 10 in $0 at line 27 fail #2 |
809908f7 |
95 | |
711cdd39 |
96 | # Failed test 11 in $0 at line 29 |
809908f7 |
97 | |
711cdd39 |
98 | # Test 12 got: <UNDEF> ($0 at line 30) |
809908f7 |
99 | # Expected: '1' |
100 | |
711cdd39 |
101 | # Failed test 13 in $0 at line 32 |
809908f7 |
102 | EXPECT |
103 | |
104 | } |