1*5759b3d2Safresh1#!perl -w 2*5759b3d2Safresh1# HARNESS-NO-PRELOAD 3*5759b3d2Safresh1 4*5759b3d2Safresh1BEGIN { 5*5759b3d2Safresh1 if( $ENV{PERL_CORE} ) { 6*5759b3d2Safresh1 chdir 't'; 7*5759b3d2Safresh1 @INC = '../lib'; 8*5759b3d2Safresh1 } 9*5759b3d2Safresh1} 10*5759b3d2Safresh1 11*5759b3d2Safresh1use Test::More tests => 17; 12*5759b3d2Safresh1 13*5759b3d2Safresh1# If we skip with the same name, Test::Harness will report it back and 14*5759b3d2Safresh1# we won't get lots of false bug reports. 15*5759b3d2Safresh1my $Why = "Just testing the skip interface."; 16*5759b3d2Safresh1 17*5759b3d2Safresh1SKIP: { 18*5759b3d2Safresh1 skip $Why, 2 19*5759b3d2Safresh1 unless Pigs->can('fly'); 20*5759b3d2Safresh1 21*5759b3d2Safresh1 my $pig = Pigs->new; 22*5759b3d2Safresh1 $pig->takeoff; 23*5759b3d2Safresh1 24*5759b3d2Safresh1 ok( $pig->altitude > 0, 'Pig is airborne' ); 25*5759b3d2Safresh1 ok( $pig->airspeed > 0, ' and moving' ); 26*5759b3d2Safresh1} 27*5759b3d2Safresh1 28*5759b3d2Safresh1 29*5759b3d2Safresh1SKIP: { 30*5759b3d2Safresh1 skip "We're not skipping", 2 if 0; 31*5759b3d2Safresh1 32*5759b3d2Safresh1 pass("Inside skip block"); 33*5759b3d2Safresh1 pass("Another inside"); 34*5759b3d2Safresh1} 35*5759b3d2Safresh1 36*5759b3d2Safresh1 37*5759b3d2Safresh1SKIP: { 38*5759b3d2Safresh1 skip "Again, not skipping", 2 if 0; 39*5759b3d2Safresh1 40*5759b3d2Safresh1 my($pack, $file, $line) = caller; 41*5759b3d2Safresh1 is( $pack || '', '', 'calling package not interfered with' ); 42*5759b3d2Safresh1 is( $file || '', '', ' or file' ); 43*5759b3d2Safresh1 is( $line || '', '', ' or line' ); 44*5759b3d2Safresh1} 45*5759b3d2Safresh1 46*5759b3d2Safresh1SKIP: { 47*5759b3d2Safresh1 skip $Why, 2 if 1; 48*5759b3d2Safresh1 49*5759b3d2Safresh1 die "A horrible death"; 50*5759b3d2Safresh1 fail("Deliberate failure"); 51*5759b3d2Safresh1 fail("And again"); 52*5759b3d2Safresh1} 53*5759b3d2Safresh1 54*5759b3d2Safresh1 55*5759b3d2Safresh1{ 56*5759b3d2Safresh1 my $warning; 57*5759b3d2Safresh1 local $SIG{__WARN__} = sub { $warning = join "", @_ }; 58*5759b3d2Safresh1 SKIP: { 59*5759b3d2Safresh1 # perl gets the line number a little wrong on the first 60*5759b3d2Safresh1 # statement inside a block. 61*5759b3d2Safresh1 1 == 1; 62*5759b3d2Safresh1#line 56 63*5759b3d2Safresh1 skip $Why; 64*5759b3d2Safresh1 fail("So very failed"); 65*5759b3d2Safresh1 } 66*5759b3d2Safresh1 is( $warning, "skip() needs to know \$how_many tests are in the ". 67*5759b3d2Safresh1 "block at $0 line 56\n", 68*5759b3d2Safresh1 'skip without $how_many warning' ); 69*5759b3d2Safresh1} 70*5759b3d2Safresh1 71*5759b3d2Safresh1 72*5759b3d2Safresh1SKIP: { 73*5759b3d2Safresh1 skip "Not skipping here.", 4 if 0; 74*5759b3d2Safresh1 75*5759b3d2Safresh1 pass("This is supposed to run"); 76*5759b3d2Safresh1 77*5759b3d2Safresh1 # Testing out nested skips. 78*5759b3d2Safresh1 SKIP: { 79*5759b3d2Safresh1 skip $Why, 2; 80*5759b3d2Safresh1 fail("AHHH!"); 81*5759b3d2Safresh1 fail("You're a failure"); 82*5759b3d2Safresh1 } 83*5759b3d2Safresh1 84*5759b3d2Safresh1 pass("This is supposed to run, too"); 85*5759b3d2Safresh1} 86*5759b3d2Safresh1 87*5759b3d2Safresh1{ 88*5759b3d2Safresh1 my $warning = ''; 89*5759b3d2Safresh1 local $SIG{__WARN__} = sub { $warning .= join "", @_ }; 90*5759b3d2Safresh1 91*5759b3d2Safresh1 SKIP: { 92*5759b3d2Safresh1 skip 1, "This is backwards" if 1; 93*5759b3d2Safresh1 94*5759b3d2Safresh1 pass "This does not run"; 95*5759b3d2Safresh1 } 96*5759b3d2Safresh1 97*5759b3d2Safresh1 like $warning, qr/^skip\(\) was passed a non-numeric number of tests/; 98*5759b3d2Safresh1} 99