lib/Test/t/fail.t

   1 # -*-perl-*-
   2 use strict;
   3 use vars qw($Expect);
   4 use Test qw($TESTOUT $TESTERR $ntest ok skip plan);
   5 plan tests => 14;
   6
   7 open F, ">fails";
   8 $TESTOUT = *F{IO};
   9 $TESTERR = *F{IO};
  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};
  36 $TESTERR = *STDERR{IO};
  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
  54 for (my $x=0; $x < @got; $x++) {
  55     ok $got[$x], $expect[$x]."\n";
  56 }
  57
  58
  59 BEGIN {
  60     $Expect = <<"EXPECT";
  61 # Failed test 1 in $0 at line 15
  62
  63 # Failed test 2 in $0 at line 17
  64
  65 # Test 3 got: '0' ($0 at line 18)
  66 #   Expected: '1'
  67
  68 # Test 4 got: '2' ($0 at line 19)
  69 #   Expected: '3'
  70
  71 # Test 5 got: '2' ($0 at line 20)
  72 #   Expected: '0'
  73
  74 # Test 6 got: '2' ($0 at line 23)
  75 #   Expected: '1' (\@list=0,0)
  76
  77 # Test 7 got: '2' ($0 at line 24)
  78 #   Expected: '1' (\@list=0,0)
  79
  80 # Test 8 got: 'segmentation fault' ($0 at line 25)
  81 #   Expected: qr{bongo}
  82
  83 # Failed test 9 in $0 at line 27
  84
  85 # Failed test 10 in $0 at line 27 fail #2
  86
  87 # Failed test 11 in $0 at line 29
  88
  89 # Test 12 got: <UNDEF> ($0 at line 30)
  90 #    Expected: '1'
  91
  92 # Failed test 13 in $0 at line 32
  93 EXPECT
  94
  95 }