1#!/usr/bin/perl -Tw 2 3use strict; 4 5BEGIN { 6 if( $ENV{PERL_CORE} ) { 7 chdir 't'; 8 @INC = ('../lib', 'lib'); 9 } 10 else { 11 unshift @INC, 't/lib'; 12 } 13} 14 15use Test::More tests => 89; 16 17BEGIN { use_ok('Test::Harness::Straps'); } 18 19my $strap = Test::Harness::Straps->new; 20isa_ok( $strap, 'Test::Harness::Straps', 'new()' ); 21 22### Testing _is_diagnostic() 23 24my $comment; 25ok( !$strap->_is_diagnostic("foo", \$comment), '_is_diagnostic(), not a comment' ); 26ok( !defined $comment, ' no comment set' ); 27 28ok( !$strap->_is_diagnostic("f # oo", \$comment), ' not a comment with #' ); 29ok( !defined $comment, ' no comment set' ); 30 31my %comments = ( 32 "# stuff and things # and stuff" => 33 ' stuff and things # and stuff', 34 " # more things " => ' more things ', 35 "#" => '', 36 ); 37 38for my $line ( sort keys %comments ) { 39 my $line_comment = $comments{$line}; 40 my $strap = Test::Harness::Straps->new; 41 isa_ok( $strap, 'Test::Harness::Straps' ); 42 43 my $name = substr($line, 0, 20); 44 ok( $strap->_is_diagnostic($line, \$comment), " comment '$name'" ); 45 is( $comment, $line_comment, ' right comment set' ); 46} 47 48 49 50### Testing _is_header() 51 52my @not_headers = (' 1..2', 53 '1..M', 54 '1..-1', 55 '2..2', 56 '1..a', 57 '', 58 ); 59 60foreach my $unheader (@not_headers) { 61 my $strap = Test::Harness::Straps->new; 62 isa_ok( $strap, 'Test::Harness::Straps' ); 63 64 ok( !$strap->_is_header($unheader), 65 "_is_header(), not a header '$unheader'" ); 66 67 ok( (!grep { exists $strap->{$_} } qw(max todo skip_all)), 68 " max, todo and skip_all are not set" ); 69} 70 71 72my @attribs = qw(max skip_all todo); 73my %headers = ( 74 '1..2' => { max => 2 }, 75 '1..1' => { max => 1 }, 76 '1..0' => { max => 0, 77 skip_all => '', 78 }, 79 '1..0 # Skipped: no leverage found' => { max => 0, 80 skip_all => 'no leverage found', 81 }, 82 '1..4 # Skipped: no leverage found' => { max => 4, 83 skip_all => 'no leverage found', 84 }, 85 '1..0 # skip skip skip because' => { max => 0, 86 skip_all => 'skip skip because', 87 }, 88 '1..10 todo 2 4 10' => { max => 10, 89 'todo' => { 2 => 1, 90 4 => 1, 91 10 => 1, 92 }, 93 }, 94 '1..10 todo' => { max => 10 }, 95 '1..192 todo 4 2 13 192 # Skip skip skip because' => 96 { max => 192, 97 'todo' => { 4 => 1, 98 2 => 1, 99 13 => 1, 100 192 => 1, 101 }, 102 skip_all => 'skip skip because' 103 } 104); 105 106for my $header ( sort keys %headers ) { 107 my $expect = $headers{$header}; 108 my $strap = Test::Harness::Straps->new; 109 isa_ok( $strap, 'Test::Harness::Straps' ); 110 111 ok( $strap->_is_header($header), "_is_header() is a header '$header'" ); 112 113 is( $strap->{skip_all}, $expect->{skip_all}, ' skip_all set right' ) 114 if defined $expect->{skip_all}; 115 116 ok( eq_set( [map $strap->{$_}, grep defined $strap->{$_}, @attribs], 117 [map $expect->{$_}, grep defined $expect->{$_}, @attribs] ), 118 ' the right attributes are there' ); 119} 120 121 122 123### Test _is_bail_out() 124 125my %bails = ( 126 'Bail out!' => undef, 127 'Bail out! Wing on fire.' => 'Wing on fire.', 128 'BAIL OUT!' => undef, 129 'bail out! - Out of coffee' => '- Out of coffee', 130 ); 131 132for my $line ( sort keys %bails ) { 133 my $expect = $bails{$line}; 134 my $strap = Test::Harness::Straps->new; 135 isa_ok( $strap, 'Test::Harness::Straps' ); 136 137 my $reason; 138 ok( $strap->_is_bail_out($line, \$reason), "_is_bail_out() spots '$line'"); 139 is( $reason, $expect, ' with the right reason' ); 140} 141 142my @unbails = ( 143 ' Bail out!', 144 'BAIL OUT', 145 'frobnitz', 146 'ok 23 - BAIL OUT!', 147 ); 148 149foreach my $line (@unbails) { 150 my $strap = Test::Harness::Straps->new; 151 isa_ok( $strap, 'Test::Harness::Straps' ); 152 153 my $reason; 154 155 ok( !$strap->_is_bail_out($line, \$reason), 156 "_is_bail_out() ignores '$line'" ); 157 is( $reason, undef, ' and gives no reason' ); 158} 159