cpan/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
  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
  63 for (my $x=0; $x < @got; $x++) {
  64     ok commentless($got[$x]), commentless($expect[$x]."\n");
  65 }
  66
  67
  68 BEGIN {
  69     $Expect = <<"EXPECT";
  70 # Failed test 1 in $0 at line 15
  71
  72 # Failed test 2 in $0 at line 17
  73
  74 # Test 3 got: '0' ($0 at line 18)
  75 #   Expected: '1'
  76
  77 # Test 4 got: '2' ($0 at line 19)
  78 #   Expected: '3'
  79
  80 # Test 5 got: '2' ($0 at line 20)
  81 #   Expected: '0'
  82
  83 # Test 6 got: '2' ($0 at line 23)
  84 #   Expected: '1' (\@list=0,0)
  85
  86 # Test 7 got: '2' ($0 at line 24)
  87 #   Expected: '1' (\@list=0,0)
  88
  89 # Test 8 got: 'segmentation fault' ($0 at line 25)
  90 #   Expected: qr{bongo}
  91
  92 # Failed test 9 in $0 at line 27
  93
  94 # Failed test 10 in $0 at line 27 fail #2
  95
  96 # Failed test 11 in $0 at line 29
  97
  98 # Test 12 got: <UNDEF> ($0 at line 30)
  99 #    Expected: '1'
 100
 101 # Failed test 13 in $0 at line 32
 102 EXPECT
 103
 104 }