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