1#!/usr/bin/perl -w
2
3BEGIN {
4    if( $ENV{PERL_CORE} ) {
5        chdir 't';
6        @INC = ( '../lib', 'lib' );
7    }
8    else {
9        unshift @INC, 't/lib';
10    }
11}
12
13use strict;
14use warnings;
15
16use Test::Builder::NoOutput;
17
18use Test::More tests => 12;
19
20# TB Methods expect to be wrapped.
21my $ok   = sub { shift->ok(@_) };
22my $plan = sub { shift->plan(@_) };
23my $diag = sub { shift->diag(@_) };
24my $finalize = sub { shift->finalize(@_) };
25
26# Formatting may change if we're running under Test::Harness.
27$ENV{HARNESS_ACTIVE} = 0;
28
29{
30    my $tb = Test::Builder::NoOutput->create;
31
32    $tb->$plan( tests => 7 );
33    for( 1 .. 3 ) {
34        $tb->$ok( $_, "We're on $_" );
35        $tb->$diag("We ran $_");
36    }
37    {
38        my $indented = $tb->child;
39        $indented->$plan('no_plan');
40        $indented->$ok( 1, "We're on 1" );
41        $indented->$ok( 1, "We're on 2" );
42        $indented->$ok( 1, "We're on 3" );
43        $indented->$finalize;
44    }
45    for( 7, 8, 9 ) {
46        $tb->$ok( $_, "We're on $_" );
47    }
48
49    is $tb->read, <<"END", 'Output should nest properly';
501..7
51ok 1 - We're on 1
52# We ran 1
53ok 2 - We're on 2
54# We ran 2
55ok 3 - We're on 3
56# We ran 3
57    ok 1 - We're on 1
58    ok 2 - We're on 2
59    ok 3 - We're on 3
60    1..3
61ok 4 - Child of $0
62ok 5 - We're on 7
63ok 6 - We're on 8
64ok 7 - We're on 9
65END
66}
67{
68    my $tb = Test::Builder::NoOutput->create;
69
70    $tb->$plan('no_plan');
71    for( 1 .. 1 ) {
72        $tb->$ok( $_, "We're on $_" );
73        $tb->$diag("We ran $_");
74    }
75    {
76        my $indented = $tb->child;
77        $indented->$plan('no_plan');
78        $indented->$ok( 1, "We're on 1" );
79        {
80            my $indented2 = $indented->child('with name');
81            $indented2->$plan( tests => 2 );
82            $indented2->$ok( 1, "We're on 2.1" );
83            $indented2->$ok( 1, "We're on 2.1" );
84            $indented2->$finalize;
85        }
86        $indented->$ok( 1, 'after child' );
87        $indented->$finalize;
88    }
89    for(7) {
90        $tb->$ok( $_, "We're on $_" );
91    }
92
93    $tb->_ending;
94    is $tb->read, <<"END", 'We should allow arbitrary nesting';
95ok 1 - We're on 1
96# We ran 1
97    ok 1 - We're on 1
98        1..2
99        ok 1 - We're on 2.1
100        ok 2 - We're on 2.1
101    ok 2 - with name
102    ok 3 - after child
103    1..3
104ok 2 - Child of $0
105ok 3 - We're on 7
1061..3
107END
108}
109
110{
111#line 108
112    my $tb = Test::Builder::NoOutput->create;
113
114    {
115        my $child = $tb->child('expected to fail');
116        $child->$plan( tests => 3 );
117        $child->$ok(1);
118        $child->$ok(0);
119        $child->$ok(3);
120        $child->$finalize;
121    }
122
123    {
124        my $child = $tb->child('expected to pass');
125        $child->$plan( tests => 3 );
126        $child->$ok(1);
127        $child->$ok(2);
128        $child->$ok(3);
129        $child->$finalize;
130    }
131    is $tb->read, <<"END", 'Previous child failures should not force subsequent failures';
132    1..3
133    ok 1
134    not ok 2
135    #   Failed test at $0 line 114.
136    ok 3
137    # Looks like you failed 1 test of 3.
138not ok 1 - expected to fail
139#   Failed test 'expected to fail'
140#   at $0 line 116.
141    1..3
142    ok 1
143    ok 2
144    ok 3
145ok 2 - expected to pass
146END
147}
148{
149    my $tb    = Test::Builder::NoOutput->create;
150    my $child = $tb->child('one');
151    is $child->{$_}, $tb->{$_}, "The child should copy the ($_) filehandle"
152        foreach qw{Out_FH Todo_FH Fail_FH};
153    $child->$finalize;
154}
155{
156    my $tb    = Test::Builder::NoOutput->create;
157    my $child = $tb->child('one');
158    can_ok $child, 'parent';
159
160    can_ok $tb, 'name';
161    is $child->name, 'one', '... but child names should be whatever we set them to';
162    $child->$finalize;
163    $child = $tb->child;
164    $child->$finalize;
165}
166# Skip all subtests
167{
168    my $tb = Test::Builder::NoOutput->create;
169
170    {
171        my $child = $tb->child('skippy says he loves you');
172        eval { $child->$plan( skip_all => 'cuz I said so' ) };
173    }
174    subtest 'skip all', sub {
175        plan skip_all => 'subtest with skip_all';
176        ok 0, 'This should never be run';
177    };
178}
179
180# to do tests
181{
182#line 204
183    my $tb = Test::Builder::NoOutput->create;
184    $tb->$plan( tests => 1 );
185    my $child = $tb->child;
186    $child->$plan( tests => 1 );
187    $child->todo_start( 'message' );
188    $child->$ok( 0 );
189    $child->todo_end;
190    $child->$finalize;
191    $tb->_ending;
192    is $tb->read, <<"END", 'TODO tests should not make the parent test fail';
1931..1
194    1..1
195    not ok 1 # TODO message
196    #   Failed (TODO) test at $0 line 209.
197ok 1 - Child of $0
198END
199}
200{
201    my $tb = Test::Builder::NoOutput->create;
202    $tb->$plan( tests => 1 );
203    my $child = $tb->child;
204    $child->$finalize;
205    $tb->_ending;
206    my $expected = <<"END";
2071..1
208not ok 1 - No tests run for subtest "Child of $0"
209END
210    like $tb->read, qr/\Q$expected\E/,
211        'Not running subtests should make the parent test fail';
212}
213