xref: /openbsd-src/gnu/usr.bin/perl/dist/Test/t/fail.t (revision 5759b3d249badf144a6240f7eec4dcf9df003e6b)
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