cpan/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 => 80);
  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 = 38;
  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 248
 260 isa_ok(42,    "Wibble");
 261 out_ok( <<OUT, <<ERR );
 262 not ok - The thing isa Wibble
 263 OUT
 264 #   Failed test 'The thing isa Wibble'
 265 #   at $0 line 248.
 266 #     The thing isn't a class or reference
 267 ERR
 268
 269 #line 258
 270 isa_ok(undef, "Wibble", "Another Wibble");
 271 out_ok( <<OUT, <<ERR );
 272 not ok - Another Wibble isa Wibble
 273 OUT
 274 #   Failed test 'Another Wibble isa Wibble'
 275 #   at $0 line 258.
 276 #     Another Wibble isn't defined
 277 ERR
 278
 279 #line 268
 280 isa_ok([],    "HASH");
 281 out_ok( <<OUT, <<ERR );
 282 not ok - The reference isa HASH
 283 OUT
 284 #   Failed test 'The reference isa HASH'
 285 #   at $0 line 268.
 286 #     The reference isn't a 'HASH' it's a 'ARRAY'
 287 ERR
 288
 289 #line 278
 290 new_ok(undef);
 291 out_like( <<OUT, <<ERR );
 292 not ok - new\\(\\) died
 293 OUT
 294 #   Failed test 'new\\(\\) died'
 295 #   at $Filename line 278.
 296 #     Error was:  Can't call method "new" on an undefined value at .*
 297 ERR
 298
 299 #line 288
 300 new_ok( "Does::Not::Exist" );
 301 out_like( <<OUT, <<ERR );
 302 not ok - new\\(\\) died
 303 OUT
 304 #   Failed test 'new\\(\\) died'
 305 #   at $Filename line 288.
 306 #     Error was:  Can't locate object method "new" via package "Does::Not::Exist" .*
 307 ERR
 308
 309
 310 { package Foo; sub new { } }
 311 { package Bar; sub new { {} } }
 312 { package Baz; sub new { bless {}, "Wibble" } }
 313
 314 #line 303
 315 new_ok( "Foo" );
 316 out_ok( <<OUT, <<ERR );
 317 not ok - The object isa Foo
 318 OUT
 319 #   Failed test 'The object isa Foo'
 320 #   at $0 line 303.
 321 #     The object isn't defined
 322 ERR
 323
 324 # line 313
 325 new_ok( "Bar" );
 326 out_ok( <<OUT, <<ERR );
 327 not ok - The object isa Bar
 328 OUT
 329 #   Failed test 'The object isa Bar'
 330 #   at $0 line 313.
 331 #     The object isn't a 'Bar' it's a 'HASH'
 332 ERR
 333
 334 #line 323
 335 new_ok( "Baz" );
 336 out_ok( <<OUT, <<ERR );
 337 not ok - The object isa Baz
 338 OUT
 339 #   Failed test 'The object isa Baz'
 340 #   at $0 line 323.
 341 #     The object isn't a 'Baz' it's a 'Wibble'
 342 ERR
 343
 344 #line 333
 345 new_ok( "Baz", [], "no args" );
 346 out_ok( <<OUT, <<ERR );
 347 not ok - no args isa Baz
 348 OUT
 349 #   Failed test 'no args isa Baz'
 350 #   at $0 line 333.
 351 #     no args isn't a 'Baz' it's a 'Wibble'
 352 ERR
 353
 354 #line 343
 355 cmp_ok( 'foo', 'eq', 'bar', 'cmp_ok eq' );
 356 out_ok( <<OUT, <<ERR );
 357 not ok - cmp_ok eq
 358 OUT
 359 #   Failed test 'cmp_ok eq'
 360 #   at $0 line 343.
 361 #          got: 'foo'
 362 #     expected: 'bar'
 363 ERR
 364
 365 #line 354
 366 cmp_ok( 42.1,  '==', 23,  , '       ==' );
 367 out_ok( <<OUT, <<ERR );
 368 not ok -        ==
 369 OUT
 370 #   Failed test '       =='
 371 #   at $0 line 354.
 372 #          got: 42.1
 373 #     expected: 23
 374 ERR
 375
 376 #line 365
 377 cmp_ok( 42,    '!=', 42   , '       !=' );
 378 out_ok( <<OUT, <<ERR );
 379 not ok -        !=
 380 OUT
 381 #   Failed test '       !='
 382 #   at $0 line 365.
 383 #          got: 42
 384 #     expected: anything else
 385 ERR
 386
 387 #line 376
 388 cmp_ok( 1,     '&&', 0    , '       &&' );
 389 out_ok( <<OUT, <<ERR );
 390 not ok -        &&
 391 OUT
 392 #   Failed test '       &&'
 393 #   at $0 line 376.
 394 #     '1'
 395 #         &&
 396 #     '0'
 397 ERR
 398
 399 # line 388
 400 cmp_ok( 42,    'eq', "foo", '       eq with numbers' );
 401 out_ok( <<OUT, <<ERR );
 402 not ok -        eq with numbers
 403 OUT
 404 #   Failed test '       eq with numbers'
 405 #   at $0 line 388.
 406 #          got: '42'
 407 #     expected: 'foo'
 408 ERR
 409
 410 {
 411     my $warnings = '';
 412     local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
 413
 414 # line 404
 415     cmp_ok( 42,    '==', "foo", '       == with strings' );
 416     out_ok( <<OUT, <<ERR );
 417 not ok -        == with strings
 418 OUT
 419 #   Failed test '       == with strings'
 420 #   at $0 line 404.
 421 #          got: 42
 422 #     expected: foo
 423 ERR
 424     My::Test::like(
 425         $warnings,
 426         qr/^Argument "foo" isn't numeric in .* at cmp_ok \[from $Filename line 404\] line 1\.\n$/
 427     );
 428     $warnings = '';
 429 }
 430
 431
 432 {
 433     my $warnings = '';
 434     local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
 435
 436 #line 426
 437     cmp_ok( undef, "ne", "", "undef ne empty string" );
 438
 439     $TB->is_eq( $out->read, <<OUT );
 440 not ok - undef ne empty string
 441 OUT
 442
 443     TODO: {
 444         local $::TODO = 'cmp_ok() gives the wrong "expected" for undef';
 445
 446         $TB->is_eq( $err->read, <<ERR );
 447 #   Failed test 'undef ne empty string'
 448 #   at $0 line 426.
 449 #          got: undef
 450 #     expected: ''
 451 ERR
 452     }
 453
 454     My::Test::like(
 455         $warnings,
 456         qr/^Use of uninitialized value.* in string ne at cmp_ok \[from $Filename line 426\] line 1\.\n\z/
 457     );
 458 }
 459
 460
 461 # generate a $!, it changes its value by context.
 462 -e "wibblehibble";
 463 my $Errno_Number = $!+0;
 464 my $Errno_String = $!.'';
 465 #line 425
 466 cmp_ok( $!,    'eq', '',    '       eq with stringified errno' );
 467 out_ok( <<OUT, <<ERR );
 468 not ok -        eq with stringified errno
 469 OUT
 470 #   Failed test '       eq with stringified errno'
 471 #   at $0 line 425.
 472 #          got: '$Errno_String'
 473 #     expected: ''
 474 ERR
 475
 476 #line 436
 477 cmp_ok( $!,    '==', -1,    '       eq with numerified errno' );
 478 out_ok( <<OUT, <<ERR );
 479 not ok -        eq with numerified errno
 480 OUT
 481 #   Failed test '       eq with numerified errno'
 482 #   at $0 line 436.
 483 #          got: $Errno_Number
 484 #     expected: -1
 485 ERR
 486
 487 #line 447
 488 use_ok('Hooble::mooble::yooble');
 489 my $more_err_re = <<ERR;
 490 #   Failed test 'use Hooble::mooble::yooble;'
 491 #   at $Filename line 447\\.
 492 #     Tried to use 'Hooble::mooble::yooble'.
 493 #     Error:  Can't locate Hooble.* in \\\@INC .*
 494 ERR
 495 out_like(
 496     qr/^\Qnot ok - use Hooble::mooble::yooble;\E\n\z/,
 497     qr/^$more_err_re/
 498 );
 499
 500 #line 460
 501 require_ok('ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble');
 502 $more_err_re = <<ERR;
 503 #   Failed test 'require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;'
 504 #   at $Filename line 460\\.
 505 #     Tried to require 'ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'.
 506 #     Error:  Can't locate ALL.* in \\\@INC .*
 507 ERR
 508 out_like(
 509     qr/^\Qnot ok - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;\E\n\z/,
 510     qr/^$more_err_re/
 511 );
 512
 513
 514 END {
 515     out_like( <<OUT, <<ERR );
 516 OUT
 517 # Looks like you failed $Total tests of $Total.
 518 ERR
 519
 520     exit(0);
 521 }