git.maemo.org Git - pkg-perl/blob - deb-src/libtest-simple-perl/libtest-simple-perl-0.80/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 => 17);
  28
  29 sub like ($$;$) {
  30     $TB->like(@_);
  31 }
  32
  33 sub is ($$;$) {
  34     $TB->is_eq(@_);
  35 }
  36
  37 sub main::err_ok ($) {
  38     my($expect) = @_;
  39     my $got = $err->read;
  40
  41     return $TB->is_eq( $got, $expect );
  42 }
  43
  44
  45 package main;
  46
  47 require Test::More;
  48 my $Total = 30;
  49 Test::More->import(tests => $Total);
  50
  51 # This should all work in the presence of a __DIE__ handler.
  52 local $SIG{__DIE__} = sub { $TB->ok(0, "DIE handler called: ".join "", @_); };
  53
  54
  55 my $tb = Test::More->builder;
  56 $tb->use_numbers(0);
  57
  58 my $Filename = quotemeta $0;
  59
  60 # Preserve the line numbers.
  61 #line 38
  62 ok( 0, 'failing' );
  63 err_ok( <<ERR );
  64 #   Failed test 'failing'
  65 #   at $0 line 38.
  66 ERR
  67
  68 #line 40
  69 is( "foo", "bar", 'foo is bar?');
  70 is( undef, '',    'undef is empty string?');
  71 is( undef, 0,     'undef is 0?');
  72 is( '',    0,     'empty string is 0?' );
  73 err_ok( <<ERR );
  74 #   Failed test 'foo is bar?'
  75 #   at $0 line 40.
  76 #          got: 'foo'
  77 #     expected: 'bar'
  78 #   Failed test 'undef is empty string?'
  79 #   at $0 line 41.
  80 #          got: undef
  81 #     expected: ''
  82 #   Failed test 'undef is 0?'
  83 #   at $0 line 42.
  84 #          got: undef
  85 #     expected: '0'
  86 #   Failed test 'empty string is 0?'
  87 #   at $0 line 43.
  88 #          got: ''
  89 #     expected: '0'
  90 ERR
  91
  92 #line 45
  93 isnt("foo", "foo", 'foo isnt foo?' );
  94 isn't("foo", "foo",'foo isn\'t foo?' );
  95 isnt(undef, undef, 'undef isnt undef?');
  96 err_ok( <<ERR );
  97 #   Failed test 'foo isnt foo?'
  98 #   at $0 line 45.
  99 #     'foo'
 100 #         ne
 101 #     'foo'
 102 #   Failed test 'foo isn\'t foo?'
 103 #   at $0 line 46.
 104 #     'foo'
 105 #         ne
 106 #     'foo'
 107 #   Failed test 'undef isnt undef?'
 108 #   at $0 line 47.
 109 #     undef
 110 #         ne
 111 #     undef
 112 ERR
 113
 114 #line 48
 115 like( "foo", '/that/',  'is foo like that' );
 116 unlike( "foo", '/foo/', 'is foo unlike foo' );
 117 err_ok( <<ERR );
 118 #   Failed test 'is foo like that'
 119 #   at $0 line 48.
 120 #                   'foo'
 121 #     doesn't match '/that/'
 122 #   Failed test 'is foo unlike foo'
 123 #   at $0 line 49.
 124 #                   'foo'
 125 #           matches '/foo/'
 126 ERR
 127
 128 # Nick Clark found this was a bug.  Fixed in 0.40.
 129 # line 60
 130 like( "bug", '/(%)/',   'regex with % in it' );
 131 err_ok( <<ERR );
 132 #   Failed test 'regex with % in it'
 133 #   at $0 line 60.
 134 #                   'bug'
 135 #     doesn't match '/(%)/'
 136 ERR
 137
 138 #line 67
 139 fail('fail()');
 140 err_ok( <<ERR );
 141 #   Failed test 'fail()'
 142 #   at $0 line 67.
 143 ERR
 144
 145 #line 52
 146 can_ok('Mooble::Hooble::Yooble', qw(this that));
 147 can_ok('Mooble::Hooble::Yooble', ());
 148 can_ok(undef, undef);
 149 can_ok([], "foo");
 150 err_ok( <<ERR );
 151 #   Failed test 'Mooble::Hooble::Yooble->can(...)'
 152 #   at $0 line 52.
 153 #     Mooble::Hooble::Yooble->can('this') failed
 154 #     Mooble::Hooble::Yooble->can('that') failed
 155 #   Failed test 'Mooble::Hooble::Yooble->can(...)'
 156 #   at $0 line 53.
 157 #     can_ok() called with no methods
 158 #   Failed test '->can(...)'
 159 #   at $0 line 54.
 160 #     can_ok() called with empty class or reference
 161 #   Failed test 'ARRAY->can('foo')'
 162 #   at $0 line 55.
 163 #     ARRAY->can('foo') failed
 164 ERR
 165
 166 #line 55
 167 isa_ok(bless([], "Foo"), "Wibble");
 168 isa_ok(42,    "Wibble", "My Wibble");
 169 isa_ok(undef, "Wibble", "Another Wibble");
 170 isa_ok([],    "HASH");
 171 err_ok( <<ERR );
 172 #   Failed test 'The object isa Wibble'
 173 #   at $0 line 55.
 174 #     The object isn't a 'Wibble' it's a 'Foo'
 175 #   Failed test 'My Wibble isa Wibble'
 176 #   at $0 line 56.
 177 #     My Wibble isn't a reference
 178 #   Failed test 'Another Wibble isa Wibble'
 179 #   at $0 line 57.
 180 #     Another Wibble isn't defined
 181 #   Failed test 'The object isa HASH'
 182 #   at $0 line 58.
 183 #     The object isn't a 'HASH' it's a 'ARRAY'
 184 ERR
 185
 186 #line 68
 187 cmp_ok( 'foo', 'eq', 'bar', 'cmp_ok eq' );
 188 cmp_ok( 42.1,  '==', 23,  , '       ==' );
 189 cmp_ok( 42,    '!=', 42   , '       !=' );
 190 cmp_ok( 1,     '&&', 0    , '       &&' );
 191 err_ok( <<ERR );
 192 #   Failed test 'cmp_ok eq'
 193 #   at $0 line 68.
 194 #          got: 'foo'
 195 #     expected: 'bar'
 196 #   Failed test '       =='
 197 #   at $0 line 69.
 198 #          got: 42.1
 199 #     expected: 23
 200 #   Failed test '       !='
 201 #   at $0 line 70.
 202 #     '42'
 203 #         !=
 204 #     '42'
 205 #   Failed test '       &&'
 206 #   at $0 line 71.
 207 #     '1'
 208 #         &&
 209 #     '0'
 210 ERR
 211
 212
 213 # line 196
 214 cmp_ok( 42,    'eq', "foo", '       eq with numbers' );
 215 err_ok( <<ERR );
 216 #   Failed test '       eq with numbers'
 217 #   at $0 line 196.
 218 #          got: '42'
 219 #     expected: 'foo'
 220 ERR
 221
 222
 223 {
 224     my $warnings;
 225     local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
 226
 227 # line 211
 228     cmp_ok( 42,    '==', "foo", '       == with strings' );
 229     err_ok( <<ERR );
 230 #   Failed test '       == with strings'
 231 #   at $0 line 211.
 232 #          got: 42
 233 #     expected: foo
 234 ERR
 235     My::Test::like $warnings,
 236      qq[/^Argument "foo" isn't numeric in .* at $Filename line 211\\\.\n\$/];
 237
 238 }
 239
 240
 241 # generate a $!, it changes its value by context.
 242 -e "wibblehibble";
 243 my $Errno_Number = $!+0;
 244 my $Errno_String = $!.'';
 245 #line 80
 246 cmp_ok( $!,    'eq', '',    '       eq with stringified errno' );
 247 cmp_ok( $!,    '==', -1,    '       eq with numerified errno' );
 248 err_ok( <<ERR );
 249 #   Failed test '       eq with stringified errno'
 250 #   at $0 line 80.
 251 #          got: '$Errno_String'
 252 #     expected: ''
 253 #   Failed test '       eq with numerified errno'
 254 #   at $0 line 81.
 255 #          got: $Errno_Number
 256 #     expected: -1
 257 ERR
 258
 259 #line 84
 260 use_ok('Hooble::mooble::yooble');
 261
 262 my $more_err_re = <<ERR;
 263 #   Failed test 'use Hooble::mooble::yooble;'
 264 #   at $Filename line 84\\.
 265 #     Tried to use 'Hooble::mooble::yooble'.
 266 #     Error:  Can't locate Hooble.* in \\\@INC .*
 267 ERR
 268
 269 My::Test::like($err->read, "/^$more_err_re/");
 270
 271
 272 #line 85
 273 require_ok('ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble');
 274 $more_err_re = <<ERR;
 275 #   Failed test 'require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;'
 276 #   at $Filename line 85\\.
 277 #     Tried to require 'ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'.
 278 #     Error:  Can't locate ALL.* in \\\@INC .*
 279 ERR
 280
 281 My::Test::like($err->read, "/^$more_err_re/");
 282
 283
 284 #line 88
 285 END {
 286     $TB->is_eq($$out, <<OUT, 'failing output');
 287 1..$Total
 288 not ok - failing
 289 not ok - foo is bar?
 290 not ok - undef is empty string?
 291 not ok - undef is 0?
 292 not ok - empty string is 0?
 293 not ok - foo isnt foo?
 294 not ok - foo isn't foo?
 295 not ok - undef isnt undef?
 296 not ok - is foo like that
 297 not ok - is foo unlike foo
 298 not ok - regex with % in it
 299 not ok - fail()
 300 not ok - Mooble::Hooble::Yooble->can(...)
 301 not ok - Mooble::Hooble::Yooble->can(...)
 302 not ok - ->can(...)
 303 not ok - ARRAY->can('foo')
 304 not ok - The object isa Wibble
 305 not ok - My Wibble isa Wibble
 306 not ok - Another Wibble isa Wibble
 307 not ok - The object isa HASH
 308 not ok - cmp_ok eq
 309 not ok -        ==
 310 not ok -        !=
 311 not ok -        &&
 312 not ok -        eq with numbers
 313 not ok -        == with strings
 314 not ok -        eq with stringified errno
 315 not ok -        eq with numerified errno
 316 not ok - use Hooble::mooble::yooble;
 317 not ok - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;
 318 OUT
 319
 320 err_ok( <<ERR );
 321 # Looks like you failed $Total tests of $Total.
 322 ERR
 323
 324     exit(0);
 325 }