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

   1 #!perl -w
   2 # $Id: /mirror/googlecode/test-more/t/fail-more.t 60310 2008-09-07T23:47:22.837229Z schwern  $
   3
   4 BEGIN {
   5     if( $ENV{PERL_CORE} ) {
   6         chdir 't';
   7         @INC = ('../lib', 'lib');
   8     }
   9     else {
  10         unshift @INC, 't/lib';
  11     }
  12 }
  13
  14 use strict;
  15
  16 require Test::Simple::Catch;
  17 my($out, $err) = Test::Simple::Catch::caught();
  18 local $ENV{HARNESS_ACTIVE} = 0;
  19
  20
  21 # Can't use Test.pm, that's a 5.005 thing.
  22 package My::Test;
  23
  24 # This has to be a require or else the END block below runs before
  25 # Test::Builder's own and the ending diagnostics don't come out right.
  26 require Test::Builder;
  27 my $TB = Test::Builder->create;
  28 $TB->plan(tests => 23);
  29
  30 sub like ($$;$) {
  31     $TB->like(@_);
  32 }
  33
  34 sub is ($$;$) {
  35     $TB->is_eq(@_);
  36 }
  37
  38 sub main::err_ok ($) {
  39     my($expect) = @_;
  40     my $got = $err->read;
  41
  42     return $TB->is_eq( $got, $expect );
  43 }
  44
  45 sub main::err_like ($) {
  46     my($expect) = @_;
  47     my $got = $err->read;
  48
  49     return $TB->like( $got, qr/$expect/ );
  50 }
  51
  52
  53 package main;
  54
  55 require Test::More;
  56 my $Total = 36;
  57 Test::More->import(tests => $Total);
  58
  59 # This should all work in the presence of a __DIE__ handler.
  60 local $SIG{__DIE__} = sub { $TB->ok(0, "DIE handler called: ".join "", @_); };
  61
  62
  63 my $tb = Test::More->builder;
  64 $tb->use_numbers(0);
  65
  66 my $Filename = quotemeta $0;
  67
  68 # Preserve the line numbers.
  69 #line 38
  70 ok( 0, 'failing' );
  71 err_ok( <<ERR );
  72 #   Failed test 'failing'
  73 #   at $0 line 38.
  74 ERR
  75
  76 #line 40
  77 is( "foo", "bar", 'foo is bar?');
  78 is( undef, '',    'undef is empty string?');
  79 is( undef, 0,     'undef is 0?');
  80 is( '',    0,     'empty string is 0?' );
  81 err_ok( <<ERR );
  82 #   Failed test 'foo is bar?'
  83 #   at $0 line 40.
  84 #          got: 'foo'
  85 #     expected: 'bar'
  86 #   Failed test 'undef is empty string?'
  87 #   at $0 line 41.
  88 #          got: undef
  89 #     expected: ''
  90 #   Failed test 'undef is 0?'
  91 #   at $0 line 42.
  92 #          got: undef
  93 #     expected: '0'
  94 #   Failed test 'empty string is 0?'
  95 #   at $0 line 43.
  96 #          got: ''
  97 #     expected: '0'
  98 ERR
  99
 100 #line 45
 101 isnt("foo", "foo", 'foo isnt foo?' );
 102 isn't("foo", "foo",'foo isn\'t foo?' );
 103 isnt(undef, undef, 'undef isnt undef?');
 104 err_ok( <<ERR );
 105 #   Failed test 'foo isnt foo?'
 106 #   at $0 line 45.
 107 #          got: 'foo'
 108 #     expected: anything else
 109 #   Failed test 'foo isn\'t foo?'
 110 #   at $0 line 46.
 111 #          got: 'foo'
 112 #     expected: anything else
 113 #   Failed test 'undef isnt undef?'
 114 #   at $0 line 47.
 115 #          got: undef
 116 #     expected: anything else
 117 ERR
 118
 119 #line 48
 120 like( "foo", '/that/',  'is foo like that' );
 121 unlike( "foo", '/foo/', 'is foo unlike foo' );
 122 err_ok( <<ERR );
 123 #   Failed test 'is foo like that'
 124 #   at $0 line 48.
 125 #                   'foo'
 126 #     doesn't match '/that/'
 127 #   Failed test 'is foo unlike foo'
 128 #   at $0 line 49.
 129 #                   'foo'
 130 #           matches '/foo/'
 131 ERR
 132
 133 # Nick Clark found this was a bug.  Fixed in 0.40.
 134 # line 60
 135 like( "bug", '/(%)/',   'regex with % in it' );
 136 err_ok( <<ERR );
 137 #   Failed test 'regex with % in it'
 138 #   at $0 line 60.
 139 #                   'bug'
 140 #     doesn't match '/(%)/'
 141 ERR
 142
 143 #line 67
 144 fail('fail()');
 145 err_ok( <<ERR );
 146 #   Failed test 'fail()'
 147 #   at $0 line 67.
 148 ERR
 149
 150 #line 52
 151 can_ok('Mooble::Hooble::Yooble', qw(this that));
 152 can_ok('Mooble::Hooble::Yooble', ());
 153 can_ok(undef, undef);
 154 can_ok([], "foo");
 155 err_ok( <<ERR );
 156 #   Failed test 'Mooble::Hooble::Yooble->can(...)'
 157 #   at $0 line 52.
 158 #     Mooble::Hooble::Yooble->can('this') failed
 159 #     Mooble::Hooble::Yooble->can('that') failed
 160 #   Failed test 'Mooble::Hooble::Yooble->can(...)'
 161 #   at $0 line 53.
 162 #     can_ok() called with no methods
 163 #   Failed test '->can(...)'
 164 #   at $0 line 54.
 165 #     can_ok() called with empty class or reference
 166 #   Failed test 'ARRAY->can('foo')'
 167 #   at $0 line 55.
 168 #     ARRAY->can('foo') failed
 169 ERR
 170
 171 #line 55
 172 isa_ok(bless([], "Foo"), "Wibble");
 173 isa_ok(42,    "Wibble", "My Wibble");
 174 isa_ok(undef, "Wibble", "Another Wibble");
 175 isa_ok([],    "HASH");
 176 err_ok( <<ERR );
 177 #   Failed test 'The object isa Wibble'
 178 #   at $0 line 55.
 179 #     The object isn't a 'Wibble' it's a 'Foo'
 180 #   Failed test 'My Wibble isa Wibble'
 181 #   at $0 line 56.
 182 #     My Wibble isn't a reference
 183 #   Failed test 'Another Wibble isa Wibble'
 184 #   at $0 line 57.
 185 #     Another Wibble isn't defined
 186 #   Failed test 'The object isa HASH'
 187 #   at $0 line 58.
 188 #     The object isn't a 'HASH' it's a 'ARRAY'
 189 ERR
 190
 191
 192 #line 188
 193 new_ok(undef);
 194 err_like( <<ERR );
 195 #   Failed test 'new\\(\\) died'
 196 #   at $Filename line 188.
 197 #     Error was:  Can't call method "new" on an undefined value at .*
 198 ERR
 199
 200 #line 211
 201 new_ok( "Does::Not::Exist" );
 202 err_like( <<ERR );
 203 #   Failed test 'new\\(\\) died'
 204 #   at $Filename line 211.
 205 #     Error was:  Can't locate object method "new" via package "Does::Not::Exist" .*
 206 ERR
 207
 208 { package Foo; sub new { } }
 209 { package Bar; sub new { {} } }
 210 { package Baz; sub new { bless {}, "Wibble" } }
 211
 212 #line 219
 213 new_ok( "Foo" );
 214 err_ok( <<ERR );
 215 #   Failed test 'The object isa Foo'
 216 #   at $0 line 219.
 217 #     The object isn't defined
 218 ERR
 219
 220 # line 231
 221 new_ok( "Bar" );
 222 err_ok( <<ERR );
 223 #   Failed test 'The object isa Bar'
 224 #   at $0 line 231.
 225 #     The object isn't a 'Bar' it's a 'HASH'
 226 ERR
 227
 228 #line 239
 229 new_ok( "Baz" );
 230 err_ok( <<ERR );
 231 #   Failed test 'The object isa Baz'
 232 #   at $0 line 239.
 233 #     The object isn't a 'Baz' it's a 'Wibble'
 234 ERR
 235
 236 #line 247
 237 new_ok( "Baz", [], "no args" );
 238 err_ok( <<ERR );
 239 #   Failed test 'no args isa Baz'
 240 #   at $0 line 247.
 241 #     no args isn't a 'Baz' it's a 'Wibble'
 242 ERR
 243
 244
 245 #line 68
 246 cmp_ok( 'foo', 'eq', 'bar', 'cmp_ok eq' );
 247 cmp_ok( 42.1,  '==', 23,  , '       ==' );
 248 cmp_ok( 42,    '!=', 42   , '       !=' );
 249 cmp_ok( 1,     '&&', 0    , '       &&' );
 250 err_ok( <<ERR );
 251 #   Failed test 'cmp_ok eq'
 252 #   at $0 line 68.
 253 #          got: 'foo'
 254 #     expected: 'bar'
 255 #   Failed test '       =='
 256 #   at $0 line 69.
 257 #          got: 42.1
 258 #     expected: 23
 259 #   Failed test '       !='
 260 #   at $0 line 70.
 261 #          got: 42
 262 #     expected: anything else
 263 #   Failed test '       &&'
 264 #   at $0 line 71.
 265 #     '1'
 266 #         &&
 267 #     '0'
 268 ERR
 269
 270
 271 # line 196
 272 cmp_ok( 42,    'eq', "foo", '       eq with numbers' );
 273 err_ok( <<ERR );
 274 #   Failed test '       eq with numbers'
 275 #   at $0 line 196.
 276 #          got: '42'
 277 #     expected: 'foo'
 278 ERR
 279
 280
 281 {
 282     my $warnings;
 283     local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
 284
 285 # line 211
 286     cmp_ok( 42,    '==', "foo", '       == with strings' );
 287     err_ok( <<ERR );
 288 #   Failed test '       == with strings'
 289 #   at $0 line 211.
 290 #          got: 42
 291 #     expected: foo
 292 ERR
 293     My::Test::like $warnings,
 294      qq[/^Argument "foo" isn't numeric in .* at $Filename line 211\\\.\n\$/];
 295
 296 }
 297
 298
 299 # generate a $!, it changes its value by context.
 300 -e "wibblehibble";
 301 my $Errno_Number = $!+0;
 302 my $Errno_String = $!.'';
 303 #line 80
 304 cmp_ok( $!,    'eq', '',    '       eq with stringified errno' );
 305 cmp_ok( $!,    '==', -1,    '       eq with numerified errno' );
 306 err_ok( <<ERR );
 307 #   Failed test '       eq with stringified errno'
 308 #   at $0 line 80.
 309 #          got: '$Errno_String'
 310 #     expected: ''
 311 #   Failed test '       eq with numerified errno'
 312 #   at $0 line 81.
 313 #          got: $Errno_Number
 314 #     expected: -1
 315 ERR
 316
 317 #line 84
 318 use_ok('Hooble::mooble::yooble');
 319
 320 my $more_err_re = <<ERR;
 321 #   Failed test 'use Hooble::mooble::yooble;'
 322 #   at $Filename line 84\\.
 323 #     Tried to use 'Hooble::mooble::yooble'.
 324 #     Error:  Can't locate Hooble.* in \\\@INC .*
 325 ERR
 326
 327 My::Test::like($err->read, "/^$more_err_re/");
 328
 329
 330 #line 85
 331 require_ok('ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble');
 332 $more_err_re = <<ERR;
 333 #   Failed test 'require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;'
 334 #   at $Filename line 85\\.
 335 #     Tried to require 'ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'.
 336 #     Error:  Can't locate ALL.* in \\\@INC .*
 337 ERR
 338
 339 My::Test::like($err->read, "/^$more_err_re/");
 340
 341
 342 #line 88
 343 END {
 344     $TB->is_eq($$out, <<OUT, 'failing output');
 345 1..$Total
 346 not ok - failing
 347 not ok - foo is bar?
 348 not ok - undef is empty string?
 349 not ok - undef is 0?
 350 not ok - empty string is 0?
 351 not ok - foo isnt foo?
 352 not ok - foo isn't foo?
 353 not ok - undef isnt undef?
 354 not ok - is foo like that
 355 not ok - is foo unlike foo
 356 not ok - regex with % in it
 357 not ok - fail()
 358 not ok - Mooble::Hooble::Yooble->can(...)
 359 not ok - Mooble::Hooble::Yooble->can(...)
 360 not ok - ->can(...)
 361 not ok - ARRAY->can('foo')
 362 not ok - The object isa Wibble
 363 not ok - My Wibble isa Wibble
 364 not ok - Another Wibble isa Wibble
 365 not ok - The object isa HASH
 366 not ok - new() died
 367 not ok - new() died
 368 not ok - The object isa Foo
 369 not ok - The object isa Bar
 370 not ok - The object isa Baz
 371 not ok - no args isa Baz
 372 not ok - cmp_ok eq
 373 not ok -        ==
 374 not ok -        !=
 375 not ok -        &&
 376 not ok -        eq with numbers
 377 not ok -        == with strings
 378 not ok -        eq with stringified errno
 379 not ok -        eq with numerified errno
 380 not ok - use Hooble::mooble::yooble;
 381 not ok - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;
 382 OUT
 383
 384 err_ok( <<ERR );
 385 # Looks like you failed $Total tests of $Total.
 386 ERR
 387
 388     exit(0);
 389 }