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