15759b3d2Safresh1#!perl -w 25759b3d2Safresh1 35759b3d2Safresh1BEGIN { 45759b3d2Safresh1 if( $ENV{PERL_CORE} ) { 55759b3d2Safresh1 chdir 't'; 65759b3d2Safresh1 @INC = '../lib'; 75759b3d2Safresh1 } 85759b3d2Safresh1} 95759b3d2Safresh1 105759b3d2Safresh1use Test::More; 115759b3d2Safresh1 12*256a93a4Safresh1use strict; 13*256a93a4Safresh1use warnings; 14*256a93a4Safresh1 155759b3d2Safresh1plan tests => 36; 165759b3d2Safresh1 175759b3d2Safresh1 18*256a93a4Safresh1my $Why = 'Just testing the todo interface.'; 195759b3d2Safresh1 205759b3d2Safresh1my $is_todo; 215759b3d2Safresh1TODO: { 225759b3d2Safresh1 local $TODO = $Why; 235759b3d2Safresh1 245759b3d2Safresh1 fail("Expected failure"); 255759b3d2Safresh1 fail("Another expected failure"); 265759b3d2Safresh1 275759b3d2Safresh1 $is_todo = Test::More->builder->todo; 285759b3d2Safresh1} 295759b3d2Safresh1 305759b3d2Safresh1pass("This is not todo"); 315759b3d2Safresh1ok( $is_todo, 'TB->todo' ); 325759b3d2Safresh1 335759b3d2Safresh1 345759b3d2Safresh1TODO: { 355759b3d2Safresh1 local $TODO = $Why; 365759b3d2Safresh1 375759b3d2Safresh1 fail("Yet another failure"); 385759b3d2Safresh1} 395759b3d2Safresh1 405759b3d2Safresh1pass("This is still not todo"); 415759b3d2Safresh1 425759b3d2Safresh1 435759b3d2Safresh1TODO: { 445759b3d2Safresh1 local $TODO = "testing that error messages don't leak out of todo"; 455759b3d2Safresh1 465759b3d2Safresh1 ok( 'this' eq 'that', 'ok' ); 475759b3d2Safresh1 485759b3d2Safresh1 like( 'this', qr/that/, 'like' ); 495759b3d2Safresh1 is( 'this', 'that', 'is' ); 505759b3d2Safresh1 isnt( 'this', 'this', 'isnt' ); 515759b3d2Safresh1 525759b3d2Safresh1 can_ok('Fooble', 'yarble'); 535759b3d2Safresh1 isa_ok('Fooble', 'yarble'); 545759b3d2Safresh1 use_ok('Fooble'); 555759b3d2Safresh1 require_ok('Fooble'); 565759b3d2Safresh1} 575759b3d2Safresh1 585759b3d2Safresh1 595759b3d2Safresh1TODO: { 605759b3d2Safresh1 todo_skip "Just testing todo_skip", 2; 615759b3d2Safresh1 625759b3d2Safresh1 fail("Just testing todo"); 635759b3d2Safresh1 die "todo_skip should prevent this"; 645759b3d2Safresh1 pass("Again"); 655759b3d2Safresh1} 665759b3d2Safresh1 675759b3d2Safresh1 685759b3d2Safresh1{ 695759b3d2Safresh1 my $warning; 705759b3d2Safresh1 local $SIG{__WARN__} = sub { $warning = join "", @_ }; 715759b3d2Safresh1 TODO: { 725759b3d2Safresh1 # perl gets the line number a little wrong on the first 735759b3d2Safresh1 # statement inside a block. 745759b3d2Safresh1 1 == 1; 755759b3d2Safresh1#line 74 765759b3d2Safresh1 todo_skip "Just testing todo_skip"; 775759b3d2Safresh1 fail("So very failed"); 785759b3d2Safresh1 } 795759b3d2Safresh1 is( $warning, "todo_skip() needs to know \$how_many tests are in the ". 805759b3d2Safresh1 "block at $0 line 74\n", 815759b3d2Safresh1 'todo_skip without $how_many warning' ); 825759b3d2Safresh1} 835759b3d2Safresh1 845759b3d2Safresh1my $builder = Test::More->builder; 855759b3d2Safresh1my $exported_to = $builder->exported_to; 865759b3d2Safresh1TODO: { 875759b3d2Safresh1 $builder->exported_to("Wibble"); 885759b3d2Safresh1 895759b3d2Safresh1 local $TODO = "testing \$TODO with an incorrect exported_to()"; 905759b3d2Safresh1 915759b3d2Safresh1 fail("Just testing todo"); 925759b3d2Safresh1} 935759b3d2Safresh1 945759b3d2Safresh1$builder->exported_to($exported_to); 955759b3d2Safresh1 965759b3d2Safresh1$builder->todo_start('Expected failures'); 975759b3d2Safresh1fail('Testing todo_start()'); 985759b3d2Safresh1ok 0, 'Testing todo_start() with more than one failure'; 995759b3d2Safresh1$is_todo = $builder->todo; 1005759b3d2Safresh1$builder->todo_end; 1015759b3d2Safresh1is $is_todo, 'Expected failures', 1025759b3d2Safresh1 'todo_start should have the correct TODO message'; 1035759b3d2Safresh1ok 1, 'todo_end() should not leak TODO behavior'; 1045759b3d2Safresh1 1055759b3d2Safresh1my @nested_todo; 1065759b3d2Safresh1my ( $level1, $level2 ) = ( 'failure level 1', 'failure_level 2' ); 1075759b3d2Safresh1TODO: { 1085759b3d2Safresh1 local $TODO = 'Nesting TODO'; 1095759b3d2Safresh1 fail('fail 1'); 1105759b3d2Safresh1 1115759b3d2Safresh1 $builder->todo_start($level1); 1125759b3d2Safresh1 fail('fail 2'); 1135759b3d2Safresh1 1145759b3d2Safresh1 push @nested_todo => $builder->todo; 1155759b3d2Safresh1 $builder->todo_start($level2); 1165759b3d2Safresh1 fail('fail 3'); 1175759b3d2Safresh1 1185759b3d2Safresh1 push @nested_todo => $builder->todo; 1195759b3d2Safresh1 $builder->todo_end; 1205759b3d2Safresh1 fail('fail 4'); 1215759b3d2Safresh1 1225759b3d2Safresh1 push @nested_todo => $builder->todo; 1235759b3d2Safresh1 $builder->todo_end; 1245759b3d2Safresh1 $is_todo = $builder->todo; 1255759b3d2Safresh1 fail('fail 4'); 1265759b3d2Safresh1} 1275759b3d2Safresh1is_deeply \@nested_todo, [ $level1, $level2, $level1 ], 1285759b3d2Safresh1 'Nested TODO message should be correct'; 1295759b3d2Safresh1is $is_todo, 'Nesting TODO', 1305759b3d2Safresh1 '... and original TODO message should be correct'; 1315759b3d2Safresh1 1325759b3d2Safresh1{ 1335759b3d2Safresh1 $builder->todo_start; 1345759b3d2Safresh1 fail("testing todo_start() with no message"); 1355759b3d2Safresh1 my $reason = $builder->todo; 1365759b3d2Safresh1 my $in_todo = $builder->in_todo; 1375759b3d2Safresh1 $builder->todo_end; 1385759b3d2Safresh1 1395759b3d2Safresh1 is $reason, '', " todo() reports no reason"; 1405759b3d2Safresh1 ok $in_todo, " but we're in_todo()"; 1415759b3d2Safresh1} 1425759b3d2Safresh1 1435759b3d2Safresh1eval { 1445759b3d2Safresh1 $builder->todo_end; 1455759b3d2Safresh1}; 1465759b3d2Safresh1is $@, sprintf "todo_end() called without todo_start() at %s line %d.\n", $0, __LINE__ - 3; 1475759b3d2Safresh1 1485759b3d2Safresh1 1495759b3d2Safresh1{ 1505759b3d2Safresh1 my($reason, $in_todo); 1515759b3d2Safresh1 1525759b3d2Safresh1 TODO: { 1535759b3d2Safresh1 local $TODO = ''; 1545759b3d2Safresh1 $reason = $builder->todo; 1555759b3d2Safresh1 $in_todo = $builder->in_todo; 1565759b3d2Safresh1 } 1575759b3d2Safresh1 1585759b3d2Safresh1 is $reason, ''; 1595759b3d2Safresh1 ok !$in_todo, '$TODO = "" is not considered TODO'; 1605759b3d2Safresh1} 161