cpan/Test-Simple/t/subtest/todo.t

   1 #!/usr/bin/perl -w
   2
   3 # Test todo subtests.
   4 #
   5 # A subtest in a todo context should have all of its diagnostic output
   6 # redirected to the todo output destination, but individual tests
   7 # within the subtest should not become todo tests themselves.
   8
   9 BEGIN {
  10     if( $ENV{PERL_CORE} ) {
  11         chdir 't';
  12         @INC = ( '../lib', 'lib' );
  13     }
  14     else {
  15         unshift @INC, 't/lib';
  16     }
  17 }
  18
  19 use strict;
  20 use warnings;
  21
  22 use Test::More;
  23 use Test::Builder;
  24 use Test::Builder::Tester;
  25
  26 # Formatting may change if we're running under Test::Harness.
  27 $ENV{HARNESS_ACTIVE} = 0;
  28
  29 our %line;
  30
  31 # Repeat each test for various combinations of the todo reason,
  32 # the mechanism by which it is set and $Level.
  33 our @test_combos;
  34 foreach my $level (1, 2, 3) {
  35     push @test_combos, ['$TODO',       'Reason',  $level],
  36                        ['todo_start',  'Reason',  $level],
  37                        ['todo_start',  '',        $level],
  38                        ['todo_start',  0,         $level];
  39 }
  40
  41 plan tests => 8 * @test_combos;
  42
  43 sub test_subtest_in_todo {
  44     my ($name, $code, $want_out, $no_tests_run) = @_;
  45
  46     my $xxx = $no_tests_run ? 'No tests run for subtest "xxx"' : 'xxx';
  47
  48     chomp $want_out;
  49     my @outlines = split /\n/, $want_out;
  50
  51     foreach my $combo (@test_combos) {
  52         my ($set_via, $todo_reason, $level) = @$combo;
  53
  54         test_out(
  55             "    # Subtest: xxx",
  56             @outlines,
  57             "not ok 1 - $xxx # TODO $todo_reason",
  58             "#   Failed (TODO) test '$xxx'",
  59             "#   at $0 line $line{xxx}.",
  60             "not ok 2 - regular todo test # TODO $todo_reason",
  61             "#   Failed (TODO) test 'regular todo test'",
  62             "#   at $0 line $line{reg}.",
  63         );
  64
  65         {
  66             local $TODO = $set_via eq '$TODO' ? $todo_reason : undef;
  67             if ($set_via eq 'todo_start') {
  68                 Test::Builder->new->todo_start($todo_reason);
  69             }
  70
  71             subtest_at_level(
  72                         'xxx', $code, $level); BEGIN{ $line{xxx} = __LINE__ }
  73             ok 0, 'regular todo test';         BEGIN{ $line{reg} = __LINE__ }
  74
  75             if ($set_via eq 'todo_start') {
  76                 Test::Builder->new->todo_end;
  77             }
  78         }
  79
  80         test_test("$name ($level), todo [$todo_reason] set via $set_via");
  81     }
  82 }
  83
  84 package Foo; # If several stack frames are in package 'main' then $Level
  85              # could be wrong and $main::TODO might still be found.  Using
  86              # another package makes the tests more sensitive.
  87
  88 sub main::subtest_at_level {
  89     my ($name, $code, $level) = @_;
  90
  91     if ($level > 1) {
  92         local $Test::Builder::Level = $Test::Builder::Level + 1;
  93         main::subtest_at_level($name, $code, $level-1);
  94     }
  95     else {
  96         Test::Builder->new->subtest($name => $code);
  97     }
  98 }
  99
 100 package main;
 101
 102 test_subtest_in_todo("plan, no tests run", sub {
 103     plan tests => 2;
 104 }, <<END, 1);
 105     1..2
 106     # No tests run!
 107 END
 108
 109 test_subtest_in_todo("noplan, no tests run", sub {
 110     plan 'no_plan';
 111 }, <<END, 1);
 112     # No tests run!
 113 END
 114
 115 test_subtest_in_todo("missingplan, no tests run", sub {
 116     1;
 117 }, <<END, 1);
 118     1..0
 119     # No tests run!
 120 END
 121
 122 test_subtest_in_todo("donetesting, no tests run", sub {
 123     done_testing;
 124 }, <<END, 1);
 125     1..0
 126     # No tests run!
 127 END
 128
 129 test_subtest_in_todo("1 failed test", sub {
 130     ok 0, 'failme'; BEGIN { $line{fail1} = __LINE__ }
 131 }, <<END);
 132     not ok 1 - failme
 133     #   Failed test 'failme'
 134     #   at $0 line $line{fail1}.
 135     1..1
 136     # Looks like you failed 1 test of 1.
 137 END
 138
 139 test_subtest_in_todo("1fail, wrongplan", sub {
 140     plan tests => 17;
 141     ok 0, 'failme'; BEGIN { $line{fail2} = __LINE__ }
 142 }, <<END);
 143     1..17
 144     not ok 1 - failme
 145     #   Failed test 'failme'
 146     #   at $0 line $line{fail2}.
 147     # Looks like you planned 17 tests but ran 1.
 148     # Looks like you failed 1 test of 1 run.
 149 END
 150
 151 test_subtest_in_todo("1fail, 1pass", sub {
 152     ok 0, 'failme'; BEGIN { $line{fail3} = __LINE__ }
 153     ok 1, 'passme';
 154 }, <<END);
 155     not ok 1 - failme
 156     #   Failed test 'failme'
 157     #   at $0 line $line{fail3}.
 158     ok 2 - passme
 159     1..2
 160     # Looks like you failed 1 test of 2.
 161 END
 162
 163 test_subtest_in_todo("todo tests in the subtest", sub {
 164     ok 0, 'inner test 1';             BEGIN{ $line{in1} = __LINE__ }
 165
 166     TODO: {
 167         local $TODO = 'Inner1';
 168         ok 0, 'failing TODO a';       BEGIN{ $line{fta} = __LINE__ }
 169         ok 1, 'unexpected pass a';
 170     }
 171
 172     ok 0, 'inner test 2';             BEGIN{ $line{in2} = __LINE__ }
 173
 174     Test::Builder->new->todo_start('Inner2');
 175     ok 0, 'failing TODO b';           BEGIN{ $line{ftb} = __LINE__ }
 176     ok 1, 'unexpected pass b';
 177     Test::Builder->new->todo_end;
 178
 179     ok 0, 'inner test 3';             BEGIN{ $line{in3} = __LINE__ }
 180 }, <<END);
 181     not ok 1 - inner test 1
 182     #   Failed test 'inner test 1'
 183     #   at $0 line $line{in1}.
 184     not ok 2 - failing TODO a # TODO Inner1
 185     #   Failed (TODO) test 'failing TODO a'
 186     #   at $0 line $line{fta}.
 187     ok 3 - unexpected pass a # TODO Inner1
 188     not ok 4 - inner test 2
 189     #   Failed test 'inner test 2'
 190     #   at $0 line $line{in2}.
 191     not ok 5 - failing TODO b # TODO Inner2
 192     #   Failed (TODO) test 'failing TODO b'
 193     #   at $0 line $line{ftb}.
 194     ok 6 - unexpected pass b # TODO Inner2
 195     not ok 7 - inner test 3
 196     #   Failed test 'inner test 3'
 197     #   at $0 line $line{in3}.
 198     1..7
 199     # Looks like you failed 3 tests of 7.
 200 END