sync a bunch of files with Test::Simple 0.86
[perl.git] / lib / Test / Simple / t / fail-like.t
1 #!/usr/bin/perl -w
2 # $Id$
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 # There was a bug with like() involving a qr// not failing properly.
15 # This tests against that.
16
17 use strict;
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 => 4);
28
29
30 require Test::Simple::Catch;
31 my($out, $err) = Test::Simple::Catch::caught();
32 local $ENV{HARNESS_ACTIVE} = 0;
33
34
35 package main;
36
37 require Test::More;
38 Test::More->import(tests => 1);
39
40 {
41     eval q{ like( "foo", qr/that/, 'is foo like that' ); };
42
43     $TB->is_eq($out->read, <<OUT, 'failing output');
44 1..1
45 not ok 1 - is foo like that
46 OUT
47
48     my $err_re = <<ERR;
49 #   Failed test 'is foo like that'
50 #   at .* line 1\.
51 #                   'foo'
52 #     doesn't match '\\(\\?-xism:that\\)'
53 ERR
54
55     $TB->like($err->read, qr/^$err_re$/, 'failing errors');
56 }
57
58 {
59     # line 60
60     like("foo", "not a regex");
61     $TB->is_eq($out->read, <<OUT);
62 not ok 2
63 OUT
64
65     $TB->is_eq($err->read, <<OUT);
66 #   Failed test at $0 line 60.
67 #     'not a regex' doesn't look much like a regex to me.
68 OUT
69
70 }
71
72 END {
73     # Test::More thinks it failed.  Override that.
74     exit(scalar grep { !$_ } $TB->summary);
75 }