lib/Test/Simple/t/fail-more.t

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