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