t/lib/Test/fail.t

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