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

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