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 Test::More; 15use File::Spec; 16 17my $Curdir = File::Spec->curdir; 18my $SAMPLE_TESTS = $ENV{PERL_CORE} 19 ? File::Spec->catdir($Curdir, 'lib', 'sample-tests') 20 : File::Spec->catdir($Curdir, 't', 'sample-tests'); 21 22 23my $IsMacPerl = $^O eq 'MacOS'; 24my $IsVMS = $^O eq 'VMS'; 25 26# VMS uses native, not POSIX, exit codes. 27my $die_exit = $IsVMS ? 44 : 1; 28 29# We can only predict that the wait status should be zero or not. 30my $wait_non_zero = 1; 31 32my %samples = ( 33 combined => { 34 passing => 0, 35 36 'exit' => 0, 37 'wait' => 0, 38 39 max => 10, 40 seen => 10, 41 42 'ok' => 8, 43 'todo' => 2, 44 'skip' => 1, 45 bonus => 1, 46 47 details => [ { 'ok' => 1, actual_ok => 1 }, 48 { 'ok' => 1, actual_ok => 1, 49 name => 'basset hounds got long ears', 50 }, 51 { 'ok' => 0, actual_ok => 0, 52 name => 'all hell broke lose', 53 }, 54 { 'ok' => 1, actual_ok => 1, 55 type => 'todo' 56 }, 57 { 'ok' => 1, actual_ok => 1 }, 58 { 'ok' => 1, actual_ok => 1 }, 59 { 'ok' => 1, actual_ok => 1, 60 type => 'skip', 61 reason => 'contract negociations' 62 }, 63 { 'ok' => 1, actual_ok => 1 }, 64 { 'ok' => 0, actual_ok => 0 }, 65 { 'ok' => 1, actual_ok => 0, 66 type => 'todo' 67 }, 68 ] 69 }, 70 71 descriptive => { 72 passing => 1, 73 74 'wait' => 0, 75 'exit' => 0, 76 77 max => 5, 78 seen => 5, 79 80 'ok' => 5, 81 'todo' => 0, 82 'skip' => 0, 83 bonus => 0, 84 85 details => [ { 'ok' => 1, actual_ok => 1, 86 name => 'Interlock activated' 87 }, 88 { 'ok' => 1, actual_ok => 1, 89 name => 'Megathrusters are go', 90 }, 91 { 'ok' => 1, actual_ok => 1, 92 name => 'Head formed', 93 }, 94 { 'ok' => 1, actual_ok => 1, 95 name => 'Blazing sword formed' 96 }, 97 { 'ok' => 1, actual_ok => 1, 98 name => 'Robeast destroyed' 99 }, 100 ], 101 }, 102 103 duplicates => { 104 passing => 0, 105 106 'exit' => 0, 107 'wait' => 0, 108 109 max => 10, 110 seen => 11, 111 112 'ok' => 11, 113 'todo' => 0, 114 'skip' => 0, 115 bonus => 0, 116 117 details => [ ({ 'ok' => 1, actual_ok => 1 }) x 10 118 ], 119 }, 120 121 head_end => { 122 passing => 1, 123 124 'exit' => 0, 125 'wait' => 0, 126 127 max => 4, 128 seen => 4, 129 130 'ok' => 4, 131 'todo' => 0, 132 'skip' => 0, 133 bonus => 0, 134 135 details => [ ({ 'ok' => 1, actual_ok => 1 }) x 4 136 ], 137 }, 138 139 lone_not_bug => { 140 passing => 1, 141 142 'exit' => 0, 143 'wait' => 0, 144 145 max => 4, 146 seen => 4, 147 148 'ok' => 4, 149 'todo' => 0, 150 'skip' => 0, 151 bonus => 0, 152 153 details => [ ({ 'ok' => 1, actual_ok => 1 }) x 4 154 ], 155 }, 156 157 head_fail => { 158 passing => 0, 159 160 'exit' => 0, 161 'wait' => 0, 162 163 max => 4, 164 seen => 4, 165 166 'ok' => 3, 167 'todo' => 0, 168 'skip' => 0, 169 bonus => 0, 170 171 details => [ { 'ok' => 1, actual_ok => 1 }, 172 { 'ok' => 0, actual_ok => 0 }, 173 ({ 'ok'=> 1, actual_ok => 1 }) x 2 174 ], 175 }, 176 177 no_output => { 178 passing => 0, 179 180 'exit' => 0, 181 'wait' => 0, 182 183 max => 0, 184 seen => 0, 185 186 'ok' => 0, 187 'todo' => 0, 188 'skip' => 0, 189 bonus => 0, 190 191 details => [], 192 }, 193 194 simple => { 195 passing => 1, 196 197 'exit' => 0, 198 'wait' => 0, 199 200 max => 5, 201 seen => 5, 202 203 'ok' => 5, 204 'todo' => 0, 205 'skip' => 0, 206 bonus => 0, 207 208 details => [ ({ 'ok' => 1, actual_ok => 1 }) x 5 209 ] 210 }, 211 212 simple_fail => { 213 passing => 0, 214 215 'exit' => 0, 216 'wait' => 0, 217 218 max => 5, 219 seen => 5, 220 221 'ok' => 3, 222 'todo' => 0, 223 'skip' => 0, 224 bonus => 0, 225 226 details => [ { 'ok' => 1, actual_ok => 1 }, 227 { 'ok' => 0, actual_ok => 0 }, 228 { 'ok' => 1, actual_ok => 1 }, 229 { 'ok' => 1, actual_ok => 1 }, 230 { 'ok' => 0, actual_ok => 0 }, 231 ] 232 }, 233 234 'skip' => { 235 passing => 1, 236 237 'exit' => 0, 238 'wait' => 0, 239 240 max => 5, 241 seen => 5, 242 243 'ok' => 5, 244 'todo' => 0, 245 'skip' => 1, 246 bonus => 0, 247 248 details => [ { 'ok' => 1, actual_ok => 1 }, 249 { 'ok' => 1, actual_ok => 1, 250 type => 'skip', 251 reason => 'rain delay', 252 }, 253 ({ 'ok' => 1, actual_ok => 1 }) x 3 254 ] 255 }, 256 257 'skip_nomsg' => { 258 passing => 1, 259 260 'exit' => 0, 261 'wait' => 0, 262 263 max => 1, 264 seen => 1, 265 266 'ok' => 1, 267 'todo' => 0, 268 'skip' => 1, 269 bonus => 0, 270 271 details => [ { 'ok' => 1, actual_ok => 1, 272 type => 'skip', 273 reason => '', 274 }, 275 ] 276 }, 277 278 skipall => { 279 passing => 1, 280 281 'exit' => 0, 282 'wait' => 0, 283 284 max => 0, 285 seen => 0, 286 skip_all => 'rope', 287 288 'ok' => 0, 289 'todo' => 0, 290 'skip' => 0, 291 bonus => 0, 292 293 details => [], 294 }, 295 296 skipall_nomsg => { 297 passing => 1, 298 299 'exit' => 0, 300 'wait' => 0, 301 302 max => 0, 303 seen => 0, 304 skip_all => '', 305 306 'ok' => 0, 307 'todo' => 0, 308 'skip' => 0, 309 bonus => 0, 310 311 details => [], 312 }, 313 314 'todo' => { 315 passing => 1, 316 317 'exit' => 0, 318 'wait' => 0, 319 320 max => 5, 321 seen => 5, 322 323 'ok' => 5, 324 'todo' => 2, 325 'skip' => 0, 326 bonus => 1, 327 328 details => [ { 'ok' => 1, actual_ok => 1 }, 329 { 'ok' => 1, actual_ok => 1, 330 type => 'todo' }, 331 { 'ok' => 1, actual_ok => 0, 332 type => 'todo' }, 333 ({ 'ok' => 1, actual_ok => 1 }) x 2 334 ], 335 }, 336 taint => { 337 passing => 1, 338 339 'exit' => 0, 340 'wait' => 0, 341 342 max => 1, 343 seen => 1, 344 345 'ok' => 1, 346 'todo' => 0, 347 'skip' => 0, 348 bonus => 0, 349 350 details => [ { 'ok' => 1, actual_ok => 1, 351 name => '- -T honored' 352 }, 353 ], 354 }, 355 vms_nit => { 356 passing => 0, 357 358 'exit' => 0, 359 'wait' => 0, 360 361 max => 2, 362 seen => 2, 363 364 'ok' => 1, 365 'todo' => 0, 366 'skip' => 0, 367 bonus => 0, 368 369 details => [ { 'ok' => 0, actual_ok => 0 }, 370 { 'ok' => 1, actual_ok => 1 }, 371 ], 372 }, 373 'die' => { 374 passing => 0, 375 376 'exit' => $die_exit, 377 'wait' => $wait_non_zero, 378 379 max => 0, 380 seen => 0, 381 382 'ok' => 0, 383 'todo' => 0, 384 'skip' => 0, 385 bonus => 0, 386 387 details => [] 388 }, 389 390 die_head_end => { 391 passing => 0, 392 393 'exit' => $die_exit, 394 'wait' => $wait_non_zero, 395 396 max => 0, 397 seen => 4, 398 399 'ok' => 4, 400 'todo' => 0, 401 'skip' => 0, 402 bonus => 0, 403 404 details => [ ({ 'ok' => 1, actual_ok => 1 }) x 4 405 ], 406 }, 407 408 die_last_minute => { 409 passing => 0, 410 411 'exit' => $die_exit, 412 'wait' => $wait_non_zero, 413 414 max => 4, 415 seen => 4, 416 417 'ok' => 4, 418 'todo' => 0, 419 'skip' => 0, 420 bonus => 0, 421 422 details => [ ({ 'ok' => 1, actual_ok => 1 }) x 4 423 ], 424 }, 425 426 bignum => { 427 passing => 0, 428 429 'exit' => 0, 430 'wait' => 0, 431 432 max => 2, 433 seen => 4, 434 435 'ok' => 4, 436 'todo' => 0, 437 'skip' => 0, 438 bonus => 0, 439 440 details => [ { 'ok' => 1, actual_ok => 1 }, 441 { 'ok' => 1, actual_ok => 1 }, 442 ] 443 }, 444 445 'shbang_misparse' =>{ 446 passing => 1, 447 448 'exit' => 0, 449 'wait' => 0, 450 451 max => 2, 452 seen => 2, 453 454 'ok' => 2, 455 'todo' => 0, 456 'skip' => 0, 457 bonus => 0, 458 459 details => [ ({ 'ok' => 1, actual_ok => 1 }) x 2 ] 460 }, 461); 462 463plan tests => (keys(%samples) * 5) + 3; 464 465use Test::Harness::Straps; 466 467$SIG{__WARN__} = sub { 468 warn @_ unless $_[0] =~ /^Enormous test number/ || 469 $_[0] =~ /^Can't detailize/ 470}; 471 472for my $test ( sort keys %samples ) { 473 my $expect = $samples{$test}; 474 475 for (0..$#{$expect->{details}}) { 476 $expect->{details}[$_]{type} = '' 477 unless exists $expect->{details}[$_]{type}; 478 $expect->{details}[$_]{name} = '' 479 unless exists $expect->{details}[$_]{name}; 480 $expect->{details}[$_]{reason} = '' 481 unless exists $expect->{details}[$_]{reason}; 482 } 483 484 my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test); 485 my $strap = Test::Harness::Straps->new; 486 isa_ok( $strap, 'Test::Harness::Straps' ); 487 my %results = $strap->analyze_file($test_path); 488 489 is_deeply($results{details}, $expect->{details}, "$test details" ); 490 491 delete $expect->{details}; 492 delete $results{details}; 493 494 SKIP: { 495 skip '$? unreliable in MacPerl', 2 if $IsMacPerl; 496 497 # We can only check if it's zero or non-zero. 498 is( !!$results{'wait'}, !!$expect->{'wait'}, 'wait status' ); 499 delete $results{'wait'}; 500 delete $expect->{'wait'}; 501 502 # Have to check the exit status seperately so we can skip it 503 # in MacPerl. 504 is( $results{'exit'}, $expect->{'exit'} ); 505 delete $results{'exit'}; 506 delete $expect->{'exit'}; 507 } 508 509 is_deeply(\%results, $expect, " the rest $test" ); 510} # for %samples 511 512NON_EXISTENT_FILE: { 513 my $strap = Test::Harness::Straps->new; 514 isa_ok( $strap, 'Test::Harness::Straps' ); 515 ok( !$strap->analyze_file('I_dont_exist') ); 516 is( $strap->{error}, "I_dont_exist does not exist" ); 517} 518