1#!perl -w 2# HARNESS-NO-STREAM 3# HARNESS-NO-PRELOAD 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 strict; 16 17require Test::Simple::Catch; 18my($out, $err) = Test::Simple::Catch::caught(); 19local $ENV{HARNESS_ACTIVE} = 0; 20 21 22# Can't use Test.pm, that's a 5.005 thing. 23package My::Test; 24 25# This has to be a require or else the END block below runs before 26# Test::Builder's own and the ending diagnostics don't come out right. 27require Test::Builder; 28my $TB = Test::Builder->create; 29$TB->plan(tests => 80); 30 31sub like ($$;$) { 32 $TB->like(@_); 33} 34 35sub is ($$;$) { 36 $TB->is_eq(@_); 37} 38 39sub main::out_ok ($$) { 40 $TB->is_eq( $out->read, shift ); 41 $TB->is_eq( $err->read, shift ); 42} 43 44sub main::out_like ($$) { 45 my($output, $failure) = @_; 46 47 $TB->like( $out->read, qr/$output/ ); 48 $TB->like( $err->read, qr/$failure/ ); 49} 50 51 52package main; 53 54require Test::More; 55our $TODO; 56my $Total = 38; 57Test::More->import(tests => $Total); 58$out->read; # clear the plan from $out 59 60# This should all work in the presence of a __DIE__ handler. 61local $SIG{__DIE__} = sub { $TB->ok(0, "DIE handler called: ".join "", @_); }; 62 63 64my $tb = Test::More->builder; 65$tb->use_numbers(0); 66 67my $Filename = quotemeta $0; 68 69 70#line 38 71ok( 0, 'failing' ); 72out_ok( <<OUT, <<ERR ); 73not ok - failing 74OUT 75# Failed test 'failing' 76# at $0 line 38. 77ERR 78 79 80#line 40 81is( "foo", "bar", 'foo is bar?'); 82out_ok( <<OUT, <<ERR ); 83not ok - foo is bar? 84OUT 85# Failed test 'foo is bar?' 86# at $0 line 40. 87# got: 'foo' 88# expected: 'bar' 89ERR 90 91#line 89 92is( undef, '', 'undef is empty string?'); 93out_ok( <<OUT, <<ERR ); 94not ok - undef is empty string? 95OUT 96# Failed test 'undef is empty string?' 97# at $0 line 89. 98# got: undef 99# expected: '' 100ERR 101 102#line 99 103is( undef, 0, 'undef is 0?'); 104out_ok( <<OUT, <<ERR ); 105not ok - undef is 0? 106OUT 107# Failed test 'undef is 0?' 108# at $0 line 99. 109# got: undef 110# expected: '0' 111ERR 112 113#line 110 114is( '', 0, 'empty string is 0?' ); 115out_ok( <<OUT, <<ERR ); 116not ok - empty string is 0? 117OUT 118# Failed test 'empty string is 0?' 119# at $0 line 110. 120# got: '' 121# expected: '0' 122ERR 123 124#line 121 125isnt("foo", "foo", 'foo isnt foo?' ); 126out_ok( <<OUT, <<ERR ); 127not ok - foo isnt foo? 128OUT 129# Failed test 'foo isnt foo?' 130# at $0 line 121. 131# got: 'foo' 132# expected: anything else 133ERR 134 135#line 132 136isn't("foo", "foo",'foo isn\'t foo?' ); 137out_ok( <<OUT, <<ERR ); 138not ok - foo isn't foo? 139OUT 140# Failed test 'foo isn\'t foo?' 141# at $0 line 132. 142# got: 'foo' 143# expected: anything else 144ERR 145 146#line 143 147isnt(undef, undef, 'undef isnt undef?'); 148out_ok( <<OUT, <<ERR ); 149not ok - undef isnt undef? 150OUT 151# Failed test 'undef isnt undef?' 152# at $0 line 143. 153# got: undef 154# expected: anything else 155ERR 156 157#line 154 158like( "foo", '/that/', 'is foo like that' ); 159out_ok( <<OUT, <<ERR ); 160not ok - is foo like that 161OUT 162# Failed test 'is foo like that' 163# at $0 line 154. 164# 'foo' 165# doesn't match '/that/' 166ERR 167 168#line 165 169unlike( "foo", '/foo/', 'is foo unlike foo' ); 170out_ok( <<OUT, <<ERR ); 171not ok - is foo unlike foo 172OUT 173# Failed test 'is foo unlike foo' 174# at $0 line 165. 175# 'foo' 176# matches '/foo/' 177ERR 178 179# Nick Clark found this was a bug. Fixed in 0.40. 180# line 177 181like( "bug", '/(%)/', 'regex with % in it' ); 182out_ok( <<OUT, <<ERR ); 183not ok - regex with % in it 184OUT 185# Failed test 'regex with % in it' 186# at $0 line 177. 187# 'bug' 188# doesn't match '/(%)/' 189ERR 190 191#line 188 192fail('fail()'); 193out_ok( <<OUT, <<ERR ); 194not ok - fail() 195OUT 196# Failed test 'fail()' 197# at $0 line 188. 198ERR 199 200#line 197 201can_ok('Mooble::Hooble::Yooble', qw(this that)); 202out_ok( <<OUT, <<ERR ); 203not ok - Mooble::Hooble::Yooble->can(...) 204OUT 205# Failed test 'Mooble::Hooble::Yooble->can(...)' 206# at $0 line 197. 207# Mooble::Hooble::Yooble->can('this') failed 208# Mooble::Hooble::Yooble->can('that') failed 209ERR 210 211#line 208 212can_ok('Mooble::Hooble::Yooble', ()); 213out_ok( <<OUT, <<ERR ); 214not ok - Mooble::Hooble::Yooble->can(...) 215OUT 216# Failed test 'Mooble::Hooble::Yooble->can(...)' 217# at $0 line 208. 218# can_ok() called with no methods 219ERR 220 221#line 218 222can_ok(undef, undef); 223out_ok( <<OUT, <<ERR ); 224not ok - ->can(...) 225OUT 226# Failed test '->can(...)' 227# at $0 line 218. 228# can_ok() called with empty class or reference 229ERR 230 231#line 228 232can_ok([], "foo"); 233out_ok( <<OUT, <<ERR ); 234not ok - ARRAY->can('foo') 235OUT 236# Failed test 'ARRAY->can('foo')' 237# at $0 line 228. 238# ARRAY->can('foo') failed 239ERR 240 241#line 238 242isa_ok(bless([], "Foo"), "Wibble"); 243out_ok( <<OUT, <<ERR ); 244not ok - An object of class 'Foo' isa 'Wibble' 245OUT 246# Failed test 'An object of class 'Foo' isa 'Wibble'' 247# at $0 line 238. 248# The object of class 'Foo' isn't a 'Wibble' 249ERR 250 251#line 248 252isa_ok(42, "Wibble", "My Wibble"); 253out_ok( <<OUT, <<ERR ); 254not ok - 'My Wibble' isa 'Wibble' 255OUT 256# Failed test ''My Wibble' isa 'Wibble'' 257# at $0 line 248. 258# 'My Wibble' isn't a 'Wibble' 259ERR 260 261#line 252 262isa_ok(42, "Wibble"); 263out_ok( <<OUT, <<ERR ); 264not ok - The class (or class-like) '42' isa 'Wibble' 265OUT 266# Failed test 'The class (or class-like) '42' isa 'Wibble'' 267# at $0 line 252. 268# The class (or class-like) '42' isn't a 'Wibble' 269ERR 270 271#line 258 272isa_ok(undef, "Wibble", "Another Wibble"); 273out_ok( <<OUT, <<ERR ); 274not ok - 'Another Wibble' isa 'Wibble' 275OUT 276# Failed test ''Another Wibble' isa 'Wibble'' 277# at $0 line 258. 278# 'Another Wibble' isn't defined 279ERR 280 281#line 268 282isa_ok([], "HASH"); 283out_ok( <<OUT, <<ERR ); 284not ok - A reference of type 'ARRAY' isa 'HASH' 285OUT 286# Failed test 'A reference of type 'ARRAY' isa 'HASH'' 287# at $0 line 268. 288# The reference of type 'ARRAY' isn't a 'HASH' 289ERR 290 291#line 278 292new_ok(undef); 293out_like( <<OUT, <<ERR ); 294not ok - undef->new\\(\\) died 295OUT 296# Failed test 'undef->new\\(\\) died' 297# at $Filename line 278. 298# Error was: Can't call method "new" on an undefined value at .* 299ERR 300 301#line 288 302new_ok( "Does::Not::Exist" ); 303out_like( <<OUT, <<ERR ); 304not ok - Does::Not::Exist->new\\(\\) died 305OUT 306# Failed test 'Does::Not::Exist->new\\(\\) died' 307# at $Filename line 288. 308# Error was: Can't locate object method "new" via package "Does::Not::Exist" .* 309ERR 310 311 312{ package Foo; sub new { } } 313{ package Bar; sub new { {} } } 314{ package Baz; sub new { bless {}, "Wibble" } } 315 316#line 303 317new_ok( "Foo" ); 318out_ok( <<OUT, <<ERR ); 319not ok - undef isa 'Foo' 320OUT 321# Failed test 'undef isa 'Foo'' 322# at $0 line 303. 323# undef isn't defined 324ERR 325 326# line 313 327new_ok( "Bar" ); 328out_ok( <<OUT, <<ERR ); 329not ok - A reference of type 'HASH' isa 'Bar' 330OUT 331# Failed test 'A reference of type 'HASH' isa 'Bar'' 332# at $0 line 313. 333# The reference of type 'HASH' isn't a 'Bar' 334ERR 335 336#line 323 337new_ok( "Baz" ); 338out_ok( <<OUT, <<ERR ); 339not ok - An object of class 'Wibble' isa 'Baz' 340OUT 341# Failed test 'An object of class 'Wibble' isa 'Baz'' 342# at $0 line 323. 343# The object of class 'Wibble' isn't a 'Baz' 344ERR 345 346#line 333 347new_ok( "Baz", [], "no args" ); 348out_ok( <<OUT, <<ERR ); 349not ok - 'no args' isa 'Baz' 350OUT 351# Failed test ''no args' isa 'Baz'' 352# at $0 line 333. 353# 'no args' isn't a 'Baz' 354ERR 355 356#line 343 357cmp_ok( 'foo', 'eq', 'bar', 'cmp_ok eq' ); 358out_ok( <<OUT, <<ERR ); 359not ok - cmp_ok eq 360OUT 361# Failed test 'cmp_ok eq' 362# at $0 line 343. 363# got: 'foo' 364# expected: 'bar' 365ERR 366 367#line 354 368cmp_ok( 42.1, '==', 23, , ' ==' ); 369out_ok( <<OUT, <<ERR ); 370not ok - == 371OUT 372# Failed test ' ==' 373# at $0 line 354. 374# got: 42.1 375# expected: 23 376ERR 377 378#line 365 379cmp_ok( 42, '!=', 42 , ' !=' ); 380out_ok( <<OUT, <<ERR ); 381not ok - != 382OUT 383# Failed test ' !=' 384# at $0 line 365. 385# got: 42 386# expected: anything else 387ERR 388 389#line 376 390cmp_ok( 1, '&&', 0 , ' &&' ); 391out_ok( <<OUT, <<ERR ); 392not ok - && 393OUT 394# Failed test ' &&' 395# at $0 line 376. 396# '1' 397# && 398# '0' 399ERR 400 401# line 388 402cmp_ok( 42, 'eq', "foo", ' eq with numbers' ); 403out_ok( <<OUT, <<ERR ); 404not ok - eq with numbers 405OUT 406# Failed test ' eq with numbers' 407# at $0 line 388. 408# got: '42' 409# expected: 'foo' 410ERR 411 412{ 413 my $warnings = ''; 414 local $SIG{__WARN__} = sub { $warnings .= join '', @_ }; 415 416# line 415 417 cmp_ok( 42, '==', "foo", ' == with strings' ); 418 out_ok( <<OUT, <<ERR ); 419not ok - == with strings 420OUT 421# Failed test ' == with strings' 422# at $0 line 415. 423# got: 42 424# expected: foo 425ERR 426 My::Test::like( 427 $warnings, 428 qr/^Argument "foo" isn't numeric in .* at \(eval in cmp_ok\) $Filename line 415\.\n$/ 429 ); 430 $warnings = ''; 431} 432 433 434{ 435 my $warnings = ''; 436 local $SIG{__WARN__} = sub { $warnings .= join '', @_ }; 437 438#line 437 439 cmp_ok( undef, "ne", "", "undef ne empty string" ); 440 441 $TB->is_eq( $out->read, <<OUT ); 442not ok - undef ne empty string 443OUT 444 445 $TB->is_eq( $err->read, <<ERR ); 446# Failed test 'undef ne empty string' 447# at $0 line 437. 448# undef 449# ne 450# '' 451ERR 452 453 My::Test::like( 454 $warnings, 455 qr/^Use of uninitialized value.* in string ne at \(eval in cmp_ok\) $Filename line 437.\n\z/ 456 ); 457} 458 459 460# generate a $!, it changes its value by context. 461-e "wibblehibble"; 462my $Errno_Number = $!+0; 463my $Errno_String = $!.''; 464#line 425 465cmp_ok( $!, 'eq', '', ' eq with stringified errno' ); 466out_ok( <<OUT, <<ERR ); 467not ok - eq with stringified errno 468OUT 469# Failed test ' eq with stringified errno' 470# at $0 line 425. 471# got: '$Errno_String' 472# expected: '' 473ERR 474 475#line 436 476cmp_ok( $!, '==', -1, ' eq with numerified errno' ); 477out_ok( <<OUT, <<ERR ); 478not ok - eq with numerified errno 479OUT 480# Failed test ' eq with numerified errno' 481# at $0 line 436. 482# got: $Errno_Number 483# expected: -1 484ERR 485 486#line 447 487use_ok('Hooble::mooble::yooble'); 488my $more_err_re = <<ERR; 489# Failed test 'use Hooble::mooble::yooble;' 490# at $Filename line 447\\. 491# Tried to use 'Hooble::mooble::yooble'. 492# Error: Can't locate Hooble.* in \\\@INC .* 493ERR 494out_like( 495 qr/^\Qnot ok - use Hooble::mooble::yooble;\E\n\z/, 496 qr/^$more_err_re/ 497); 498 499#line 460 500require_ok('ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'); 501$more_err_re = <<ERR; 502# Failed test 'require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;' 503# at $Filename line 460\\. 504# Tried to require 'ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'. 505# Error: Can't locate ALL.* in \\\@INC .* 506ERR 507out_like( 508 qr/^\Qnot ok - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;\E\n\z/, 509 qr/^$more_err_re/ 510); 511 512 513END { 514 out_like( <<OUT, <<ERR ); 515OUT 516# Looks like you failed $Total tests of $Total. 517ERR 518 519 exit(0); 520} 521