1#!perl -T 2# -*- mode: cperl ; compile-command: "cd .. ; ./Build ; prove -vb t/10-*.t" -*- 3 4BEGIN { $_ = defined && /(.*)/ && $1 for @ENV{qw/ TMPDIR TEMP TMP /} } # taint vs tempfile 5use Test::Tester; 6use Test::More tests => 2 + 3 + 7*15 + 5*3; 7use strict; 8use warnings; 9 10use Test::Trap qw( trap $T ); 11use Test::Trap qw( diag_all $T :on_fail(diag_all) ); 12use Test::Trap qw( diag_all_once $T :on_fail(diag_all_once) ); 13 14# Trap with warning and return 15my ($prem, @t) = run_tests 16 ( sub { 17 my $t = trap { warn "A warning"; 5 }; 18 $T->return_is_deeply( [5], '5 was returned' ); 19 $T->warn_like( 0, qr/^A warning\b/, 'A warning was given' ); 20 }, 21 ); 22is( $prem, '' ); 23is( $#t, 1 ); 24is( $t[0]{ok}, 1, '->return_is_deeply [5]'); 25is( $t[0]{actual_ok}, 1 ); 26is( $t[0]{name}, '5 was returned' ); 27is( $t[0]{diag}, '' ); 28is( $t[0]{depth}, 1 ); 29is( $t[1]{ok}, 1, '->warn_like'); 30is( $t[1]{actual_ok}, 1 ); 31is( $t[1]{name}, 'A warning was given' ); 32is( $t[1]{diag}, '' ); 33is( $t[1]{depth}, 1 ); 34 35# Trap with silent exit 36($prem, @t) = run_tests 37 ( sub { 38 my $t = trap { exit }; 39 $T->return_is_deeply( [5], '5 was returned' ); 40 }, 41 ); 42is( $prem, '' ); 43is( $#t, 0 ); 44is( $t[0]{ok}, 0, '->return_is_deeply [5]'); 45is( $t[0]{actual_ok}, 0 ); 46is( $t[0]{name}, '5 was returned' ); 47is( $t[0]{diag}, <<'EOE' ); 48 Expecting to return(), but instead exit()ed with 0 49EOE 50is( $t[0]{depth}, 1 ); 51 52# Trap with exception and diag_all 53($prem, @t) = run_tests 54 ( sub { 55 my $t = diag_all { die "Argh\n" }; 56 $T->return_nok(0, 'Return with (first) false value'); 57 $T->exit_nok(q/Exit with (Perl's idea of a) false value/); 58 }, 59 ); 60is( $prem, '' ); 61is( $#t, 1 ); 62is( $t[0]{ok}, 0, '->return_nok'); 63is( $t[0]{actual_ok}, 0 ); 64is( $t[0]{name}, 'Return with (first) false value' ); 65is( $t[0]{diag}, sprintf <<'EOE', Data::Dump::dump($T) ); 66 Expecting to return(), but instead die()ed with "Argh\n" 67%s 68EOE 69is( $t[0]{depth}, 1 ); 70is( $t[1]{ok}, 0, '->exit_nok'); 71is( $t[1]{actual_ok}, 0 ); 72is( $t[1]{name}, q/Exit with (Perl's idea of a) false value/ ); 73is( $t[1]{diag}, sprintf <<'EOE', Data::Dump::dump($T) ); 74 Expecting to exit(), but instead die()ed with "Argh\n" 75%s 76EOE 77is( $t[1]{depth}, 1 ); 78 79# Trap with print, exit, and diag_all 80($prem, @t) = run_tests 81 ( sub { 82 my $t = diag_all { print "Hello world"; exit }; 83 $T->exit_nok('Exit with false value'); 84 }, 85 ); 86is( $prem, '' ); 87is( $#t, 0 ); 88is( $t[0]{ok}, 1, '->exit_nok'); 89is( $t[0]{actual_ok}, 1 ); 90is( $t[0]{name}, 'Exit with false value' ); 91is( $t[0]{diag}, '' ); 92is( $t[0]{depth}, 1 ); 93 94# Capture some TB version dependent stuff: 95($prem, @t) = run_tests sub { isnt 5, 5 }; 96my $diag5isnt5 = $t[0]{diag}; 97 98# Trap with print, and exit 5, and diag_all_once 99($prem, @t) = run_tests 100 ( sub { 101 my $t = diag_all_once { print "Hello world"; exit 5 }; 102 $T->exit_nok('Exit with false value'); 103 $T->exit_isnt(5, 'Exit with non-5 value'); 104 }, 105 ); 106is( $prem, '' ); 107is( $#t, 1 ); 108is( $t[0]{ok}, 0, '->exit_nok'); 109is( $t[0]{actual_ok}, 0 ); 110is( $t[0]{name}, 'Exit with false value' ); 111is( $t[0]{diag}, sprintf <<'EOE', Data::Dump::dump($T) ); 112 Expecting false value in exit(), but got 5 instead 113%s 114EOE 115is( $t[0]{depth}, 1 ); 116is( $t[1]{ok}, 0, '->exit_isnt'); 117is( $t[1]{actual_ok}, 0 ); 118is( $t[1]{name}, 'Exit with non-5 value' ); 119is( $t[1]{diag}, "$diag5isnt5(as above)\n" ); 120is( $t[1]{depth}, 1 ); 121 122# Trap with multiple return values and diag_all_once 123($prem, @t) = run_tests 124 ( sub { 125 my ($t) = diag_all_once { return 3..7 }; 126 $T->return_like( 1, qr/4/, 'return[1] matches /4/' ); 127 }, 128 ); 129is( $prem, '' ); 130is( $#t, 0 ); 131is( $t[0]{ok}, 1, '->return_like'); 132is( $t[0]{actual_ok}, 1 ); 133is( $t[0]{name}, 'return[1] matches /4/' ); 134is( $t[0]{diag}, '' ); 135is( $t[0]{depth}, 1 ); 136 137# Quiet trap, with no on-test-failure callback 138($prem, @t) = run_tests 139 ( sub { 140 my ($t) = trap { return 3..7 }; 141 $T->quiet; 142 }, 143 ); 144is( $prem, '' ); 145is( $#t, 0 ); 146is( $t[0]{ok}, 1, '->quiet'); 147is( $t[0]{actual_ok}, 1 ); 148is( $t[0]{name}, '' ); 149is( $t[0]{diag}, '' ); 150is( $t[0]{depth}, 1 ); 151 152# Warning trap with diag_all_once 153($prem, @t) = run_tests 154 ( sub { 155 my ($t) = diag_all_once { warn "Hello!\n" }; 156 $T->quiet('In denial about STDERR'); 157 }, 158 ); 159is( $prem, '' ); 160is( $#t, 0 ); 161is( $t[0]{ok}, 0, '->quiet'); 162is( $t[0]{actual_ok}, 0 ); 163is( $t[0]{name}, 'In denial about STDERR' ); 164is( $t[0]{diag}, sprintf <<'EOE', Data::Dump::dump($T) ); 165Expecting no STDERR, but got "Hello!\n" 166%s 167EOE 168is( $t[0]{depth}, 1 ); 169 170# Printing trap with no on-test-failure callback 171($prem, @t) = run_tests 172 ( sub { 173 my ($t) = trap { print "Hello!\n" }; 174 $T->quiet('In denial about STDOUT'); 175 }, 176 ); 177is( $prem, '' ); 178is( $#t, 0 ); 179is( $t[0]{ok}, 0, '->quiet'); 180is( $t[0]{actual_ok}, 0 ); 181is( $t[0]{name}, 'In denial about STDOUT' ); 182is( $t[0]{diag}, <<'EOE' ); 183Expecting no STDOUT, but got "Hello!\n" 184EOE 185is( $t[0]{depth}, 1 ); 186 187# Noisy trap 188($prem, @t) = run_tests 189 ( sub { 190 my ($t) = trap { warn "world!\n"; print "Hello!\n" }; 191 $T->quiet('In denial about noise!'); 192 }, 193 ); 194is( $prem, '' ); 195is( $#t, 0 ); 196is( $t[0]{ok}, 0, '->quiet'); 197is( $t[0]{actual_ok}, 0 ); 198is( $t[0]{name}, 'In denial about noise!' ); 199is( $t[0]{diag}, <<'EOE' ); 200Expecting no STDOUT, but got "Hello!\n" 201Expecting no STDERR, but got "world!\n" 202EOE 203is( $t[0]{depth}, 1 ); 204 205# Noisy trap 206($prem, @t) = run_tests 207 ( sub { 208 my ($t) = trap { warn "world!\n"; print "Hello!\n" }; 209 $T->did_return('Should return'); 210 }, 211 ); 212is( $prem, '' ); 213is( $#t, 0 ); 214is( $t[0]{ok}, 1, '->did_return'); 215is( $t[0]{actual_ok}, 1 ); 216is( $t[0]{name}, 'Should return' ); 217is( $t[0]{diag}, '' ); 218is( $t[0]{depth}, 1 ); 219 220# Exiting trap 221($prem, @t) = run_tests 222 ( sub { 223 my ($t) = trap { exit }; 224 $T->did_exit('Should exit'); 225 }, 226 ); 227is( $prem, '' ); 228is( $#t, 0 ); 229is( $t[0]{ok}, 1, '->did_exit'); 230is( $t[0]{actual_ok}, 1 ); 231is( $t[0]{name}, 'Should exit' ); 232is( $t[0]{diag}, '' ); 233is( $t[0]{depth}, 1 ); 234 235# Exiting trap 236($prem, @t) = run_tests 237 ( sub { 238 my ($t) = trap { exit }; 239 $T->did_die('In denial about death'); 240 }, 241 ); 242is( $prem, '' ); 243is( $#t, 0 ); 244is( $t[0]{ok}, 0, '->did_die'); 245is( $t[0]{actual_ok}, 0 ); 246is( $t[0]{name}, 'In denial about death' ); 247is( $t[0]{diag}, <<'EOE' ); 248 Expecting to die(), but instead exit()ed with 0 249EOE 250is( $t[0]{depth}, 1 ); 251 252# Exiting TODO trap 253($prem, @t) = run_tests 254 ( sub { 255 TODO: { 256 local $TODO = 'Testing TODOs'; 257 my ($t) = trap { exit }; 258 $T->did_die('In denial about death'); 259 } 260 }, 261 ); 262is( $prem, '' ); 263is( $#t, 0 ); 264is( $t[0]{ok}, 1, '->did_die, TODO'); 265is( $t[0]{actual_ok}, 0 ); 266is( $t[0]{name}, 'In denial about death' ); 267is( $t[0]{diag}, <<'EOE' ); 268 Expecting to die(), but instead exit()ed with 0 269EOE 270is( $t[0]{depth}, 1 ); 271# extra 2: 272is( $t[0]{type}, 'todo', 'type = todo' ); 273is( $t[0]{reason}, 'Testing TODOs', 'reason' ); 274 275my $really_skipped = 1; 276# Exiting SKIPPED trap 277($prem, @t) = run_tests 278 ( sub { 279 SKIP: { 280 skip 'Testing SKIP', 1; 281 undef $really_skipped; 282 my ($t) = trap { exit }; 283 $T->did_die('In denial about death'); 284 } 285 }, 286 ); 287is( $prem, '' ); 288is( $#t, 0 ); 289is( $t[0]{ok}, 1, '->did_die, SKIPPED'); 290is( $t[0]{actual_ok}, 1 ); 291is( $t[0]{name}, '' ); 292is( $t[0]{diag}, '' ); 293is( $t[0]{depth}, 1 ); 294# extra 3: 295is( $t[0]{type}, 'skip', 'type = skip' ); 296is( $t[0]{reason}, 'Testing SKIP', 'reason' ); 297is( $really_skipped, 1, 'Asserting that SKIPPED code has not been run'); 298