1#!/usr/bin/perl -w 2 3BEGIN { 4 if( $ENV{PERL_CORE} ) { 5 chdir 't'; 6 @INC = ('../lib', 'lib'); 7 } 8 else { 9 unshift @INC, 't/lib'; 10 } 11} 12 13use strict; 14use File::Spec; 15 16my $Curdir = File::Spec->curdir; 17my $SAMPLE_TESTS = $ENV{PERL_CORE} 18 ? File::Spec->catdir($Curdir, 'lib', 'sample-tests') 19 : File::Spec->catdir($Curdir, 't', 'sample-tests'); 20 21 22use Test::More; 23use Dev::Null; 24 25my $IsMacPerl = $^O eq 'MacOS'; 26my $IsVMS = $^O eq 'VMS'; 27 28# VMS uses native, not POSIX, exit codes. 29# MacPerl's exit codes are broken. 30my $die_estat = $IsVMS ? 44 : 31 $IsMacPerl ? 0 : 32 1; 33 34my %samples = ( 35 simple => { 36 total => { 37 bonus => 0, 38 max => 5, 39 'ok' => 5, 40 files => 1, 41 bad => 0, 42 good => 1, 43 tests => 1, 44 sub_skipped=> 0, 45 'todo' => 0, 46 skipped => 0, 47 }, 48 failed => { }, 49 all_ok => 1, 50 }, 51 simple_fail => { 52 total => { 53 bonus => 0, 54 max => 5, 55 'ok' => 3, 56 files => 1, 57 bad => 1, 58 good => 0, 59 tests => 1, 60 sub_skipped => 0, 61 'todo' => 0, 62 skipped => 0, 63 }, 64 failed => { 65 canon => '2 5', 66 }, 67 all_ok => 0, 68 }, 69 descriptive => { 70 total => { 71 bonus => 0, 72 max => 5, 73 'ok' => 5, 74 files => 1, 75 bad => 0, 76 good => 1, 77 tests => 1, 78 sub_skipped=> 0, 79 'todo' => 0, 80 skipped => 0, 81 }, 82 failed => { }, 83 all_ok => 1, 84 }, 85 no_nums => { 86 total => { 87 bonus => 0, 88 max => 5, 89 'ok' => 4, 90 files => 1, 91 bad => 1, 92 good => 0, 93 tests => 1, 94 sub_skipped=> 0, 95 'todo' => 0, 96 skipped => 0, 97 }, 98 failed => { 99 canon => '3', 100 }, 101 all_ok => 0, 102 }, 103 'todo' => { 104 total => { 105 bonus => 1, 106 max => 5, 107 'ok' => 5, 108 files => 1, 109 bad => 0, 110 good => 1, 111 tests => 1, 112 sub_skipped=> 0, 113 'todo' => 2, 114 skipped => 0, 115 }, 116 failed => { }, 117 all_ok => 1, 118 }, 119 todo_inline => { 120 total => { 121 bonus => 1, 122 max => 3, 123 'ok' => 3, 124 files => 1, 125 bad => 0, 126 good => 1, 127 tests => 1, 128 sub_skipped => 0, 129 'todo' => 2, 130 skipped => 0, 131 }, 132 failed => { }, 133 all_ok => 1, 134 }, 135 'skip' => { 136 total => { 137 bonus => 0, 138 max => 5, 139 'ok' => 5, 140 files => 1, 141 bad => 0, 142 good => 1, 143 tests => 1, 144 sub_skipped=> 1, 145 'todo' => 0, 146 skipped => 0, 147 }, 148 failed => { }, 149 all_ok => 1, 150 }, 151 'skip_nomsg' => { 152 total => { 153 bonus => 0, 154 max => 1, 155 'ok' => 1, 156 files => 1, 157 bad => 0, 158 good => 1, 159 tests => 1, 160 sub_skipped=> 1, 161 'todo' => 0, 162 skipped => 0, 163 }, 164 failed => { }, 165 all_ok => 1, 166 }, 167 bailout => 0, 168 combined => { 169 total => { 170 bonus => 1, 171 max => 10, 172 'ok' => 8, 173 files => 1, 174 bad => 1, 175 good => 0, 176 tests => 1, 177 sub_skipped=> 1, 178 'todo' => 2, 179 skipped => 0 180 }, 181 failed => { 182 canon => '3 9', 183 }, 184 all_ok => 0, 185 }, 186 duplicates => { 187 total => { 188 bonus => 0, 189 max => 10, 190 'ok' => 11, 191 files => 1, 192 bad => 1, 193 good => 0, 194 tests => 1, 195 sub_skipped=> 0, 196 'todo' => 0, 197 skipped => 0, 198 }, 199 failed => { 200 canon => '??', 201 }, 202 all_ok => 0, 203 }, 204 head_end => { 205 total => { 206 bonus => 0, 207 max => 4, 208 'ok' => 4, 209 files => 1, 210 bad => 0, 211 good => 1, 212 tests => 1, 213 sub_skipped=> 0, 214 'todo' => 0, 215 skipped => 0, 216 }, 217 failed => { }, 218 all_ok => 1, 219 }, 220 head_fail => { 221 total => { 222 bonus => 0, 223 max => 4, 224 'ok' => 3, 225 files => 1, 226 bad => 1, 227 good => 0, 228 tests => 1, 229 sub_skipped=> 0, 230 'todo' => 0, 231 skipped => 0, 232 }, 233 failed => { 234 canon => '2', 235 }, 236 all_ok => 0, 237 }, 238 no_output => { 239 total => { 240 bonus => 0, 241 max => 0, 242 'ok' => 0, 243 files => 1, 244 bad => 1, 245 good => 0, 246 tests => 1, 247 sub_skipped => 0, 248 'todo' => 0, 249 skipped => 0, 250 }, 251 failed => { 252 }, 253 all_ok => 0, 254 }, 255 skipall => { 256 total => { 257 bonus => 0, 258 max => 0, 259 'ok' => 0, 260 files => 1, 261 bad => 0, 262 good => 1, 263 tests => 1, 264 sub_skipped=> 0, 265 'todo' => 0, 266 skipped => 1, 267 }, 268 failed => { }, 269 all_ok => 1, 270 }, 271 skipall_nomsg => { 272 total => { 273 bonus => 0, 274 max => 0, 275 'ok' => 0, 276 files => 1, 277 bad => 0, 278 good => 1, 279 tests => 1, 280 sub_skipped=> 0, 281 'todo' => 0, 282 skipped => 1, 283 }, 284 failed => { }, 285 all_ok => 1, 286 }, 287 with_comments => { 288 total => { 289 bonus => 2, 290 max => 5, 291 'ok' => 5, 292 files => 1, 293 bad => 0, 294 good => 1, 295 tests => 1, 296 sub_skipped=> 0, 297 'todo' => 4, 298 skipped => 0, 299 }, 300 failed => { }, 301 all_ok => 1, 302 }, 303 taint => { 304 total => { 305 bonus => 0, 306 max => 1, 307 'ok' => 1, 308 files => 1, 309 bad => 0, 310 good => 1, 311 tests => 1, 312 sub_skipped=> 0, 313 'todo' => 0, 314 skipped => 0, 315 }, 316 failed => { }, 317 all_ok => 1, 318 }, 319 320 taint_warn => { 321 total => { 322 bonus => 0, 323 max => 1, 324 'ok' => 1, 325 files => 1, 326 bad => 0, 327 good => 1, 328 tests => 1, 329 sub_skipped=> 0, 330 'todo' => 0, 331 skipped => 0, 332 }, 333 failed => { }, 334 all_ok => 1, 335 }, 336 337 'die' => { 338 total => { 339 bonus => 0, 340 max => 0, 341 'ok' => 0, 342 files => 1, 343 bad => 1, 344 good => 0, 345 tests => 1, 346 sub_skipped=> 0, 347 'todo' => 0, 348 skipped => 0, 349 }, 350 failed => { 351 estat => $die_estat, 352 max => '??', 353 failed => '??', 354 canon => '??', 355 }, 356 all_ok => 0, 357 }, 358 359 die_head_end => { 360 total => { 361 bonus => 0, 362 max => 0, 363 'ok' => 4, 364 files => 1, 365 bad => 1, 366 good => 0, 367 tests => 1, 368 sub_skipped=> 0, 369 'todo' => 0, 370 skipped => 0, 371 }, 372 failed => { 373 estat => $die_estat, 374 max => '??', 375 failed => '??', 376 canon => '??', 377 }, 378 all_ok => 0, 379 }, 380 381 die_last_minute => { 382 total => { 383 bonus => 0, 384 max => 4, 385 'ok' => 4, 386 files => 1, 387 bad => 1, 388 good => 0, 389 tests => 1, 390 sub_skipped=> 0, 391 'todo' => 0, 392 skipped => 0, 393 }, 394 failed => { 395 estat => $die_estat, 396 max => 4, 397 failed => 0, 398 canon => '??', 399 }, 400 all_ok => 0, 401 }, 402 bignum => { 403 total => { 404 bonus => 0, 405 max => 2, 406 'ok' => 4, 407 files => 1, 408 bad => 1, 409 good => 0, 410 tests => 1, 411 sub_skipped=> 0, 412 'todo' => 0, 413 skipped => 0, 414 }, 415 failed => { 416 canon => '??', 417 }, 418 all_ok => 0, 419 }, 420 'shbang_misparse' => { 421 total => { 422 bonus => 0, 423 max => 2, 424 'ok' => 2, 425 files => 1, 426 bad => 0, 427 good => 1, 428 tests => 1, 429 sub_skipped=> 0, 430 'todo' => 0, 431 skipped => 0, 432 }, 433 failed => { }, 434 all_ok => 1, 435 }, 436 too_many => { 437 total => { 438 bonus => 0, 439 max => 3, 440 'ok' => 7, 441 files => 1, 442 bad => 1, 443 good => 0, 444 tests => 1, 445 sub_skipped => 0, 446 'todo' => 0, 447 skipped => 0, 448 }, 449 failed => { 450 canon => '4-7', 451 }, 452 all_ok => 0, 453 }, 454 switches => { 455 total => { 456 bonus => 0, 457 max => 1, 458 'ok' => 1, 459 files => 1, 460 bad => 0, 461 good => 1, 462 tests => 1, 463 sub_skipped=> 0, 464 'todo' => 0, 465 skipped => 0, 466 }, 467 failed => { }, 468 all_ok => 1, 469 }, 470 ); 471 472plan tests => (keys(%samples) * 8); 473 474use Test::Harness; 475$Test::Harness::Switches = '"-Mstrict"'; 476 477tie *NULL, 'Dev::Null' or die $!; 478 479for my $test ( sort keys %samples ) { 480SKIP: { 481 skip "-t introduced in 5.8.0", 8 if $test eq 'taint_warn' and $] < 5.008; 482 483 my $expect = $samples{$test}; 484 485 # _run_all_tests() runs the tests but skips the formatting. 486 my($totals, $failed); 487 my $warning = ''; 488 my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test); 489 490 print STDERR "# $test\n" if $ENV{TEST_VERBOSE}; 491 eval { 492 select NULL; # _run_all_tests() isn't as quiet as it should be. 493 local $SIG{__WARN__} = sub { $warning .= join '', @_; }; 494 ($totals, $failed) = 495 Test::Harness::_run_all_tests($test_path); 496 }; 497 select STDOUT; 498 499 # $? is unreliable in MacPerl, so we'll just fudge it. 500 $failed->{estat} = $die_estat if $IsMacPerl and $failed; 501 502 SKIP: { 503 skip "special tests for bailout", 1 unless $test eq 'bailout'; 504 like( $@, '/Further testing stopped: GERONI/i' ); 505 } 506 507 SKIP: { 508 skip "don't apply to a bailout", 5 if $test eq 'bailout'; 509 is( $@, '' ); 510 is( Test::Harness::_all_ok($totals), $expect->{all_ok}, 511 "$test - all ok" ); 512 ok( defined $expect->{total}, "$test - has total" ); 513 is_deeply( {map { $_=>$totals->{$_} } keys %{$expect->{total}}}, 514 $expect->{total}, 515 "$test - totals" ); 516 is_deeply( {map { $_=>$failed->{$test_path}{$_} } 517 keys %{$expect->{failed}}}, 518 $expect->{failed}, 519 "$test - failed" ); 520 } 521 522 SKIP: { 523 skip "special tests for bignum", 1 unless $test eq 'bignum'; 524 is( $warning, <<WARN ); 525Enormous test number seen [test 100001] 526Can't detailize, too big. 527Enormous test number seen [test 136211425] 528Can't detailize, too big. 529WARN 530 531 } 532 533 SKIP: { 534 skip "bignum has known warnings", 1 if $test eq 'bignum'; 535 is( $warning, '' ); 536 } 537} 538} 539