1#!/usr/bin/perl -w
2# HARNESS-NO-STREAM
3# HARNESS-NO-PRELOAD
4
5BEGIN {
6    if( $ENV{PERL_CORE} ) {
7        chdir 't';
8        @INC = ('../lib', 'lib');
9    }
10    else {
11        unshift @INC, 't/lib';
12    }
13}
14
15# There was a bug with like() involving a qr// not failing properly.
16# This tests against that.
17
18use strict;
19
20
21# Can't use Test.pm, that's a 5.005 thing.
22package 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.
26require Test::Builder;
27my $TB = Test::Builder->create;
28$TB->plan(tests => 4);
29
30require Test::Simple::Catch;
31my($out, $err) = Test::Simple::Catch::caught();
32local $ENV{HARNESS_ACTIVE} = 0;
33
34package main;
35
36require Test::More;
37Test::More->import(tests => 1);
38
39{
40    eval q{ like( "foo", qr/that/, 'is foo like that' ); };
41
42    $TB->is_eq($out->read, <<OUT, 'failing output');
431..1
44not ok 1 - is foo like that
45OUT
46
47    # Accept both old and new-style stringification
48    my $modifiers = (qr/foobar/ =~ /\Q(?^/) ? '\\^' : '-xism';
49
50    my $err_re = <<ERR;
51#   Failed test 'is foo like that'
52#   at .* line 1\.
53#                   'foo'
54#     doesn't match '\\(\\?$modifiers:that\\)'
55ERR
56
57    $TB->like($err->read, qr/^$err_re$/, 'failing errors');
58}
59
60{
61    # line 62
62    like("foo", "not a regex");
63    $TB->is_eq($out->read, <<OUT);
64not ok 2
65OUT
66
67    $TB->is_eq($err->read, <<OUT);
68#   Failed test at $0 line 62.
69#     'not a regex' doesn't look much like a regex to me.
70OUT
71
72}
73
74END {
75    # Test::More thinks it failed.  Override that.
76    $? = scalar grep { !$_ } $TB->summary;
77}
78