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;
19use warnings;
20
21
22# Can't use Test.pm, that's a 5.005 thing.
23package My::Test;
24
25# This has to be a require or else the END block below runs before
26# Test::Builder's own and the ending diagnostics don't come out right.
27require Test::Builder;
28my $TB = Test::Builder->create;
29$TB->plan(tests => 4);
30
31require Test::Simple::Catch;
32my($out, $err) = Test::Simple::Catch::caught();
33local $ENV{HARNESS_ACTIVE} = 0;
34
35package main;
36
37require Test::More;
38Test::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');
441..1
45not ok 1 - is foo like that
46OUT
47
48    # Accept both old and new-style stringification
49    my $modifiers = (qr/foobar/ =~ /\Q(?^/) ? '\\^' : '-xism';
50
51    my $err_re = <<ERR;
52#   Failed test 'is foo like that'
53#   at .* line 1\.
54#                   'foo'
55#     doesn't match '\\(\\?$modifiers:that\\)'
56ERR
57
58    $TB->like($err->read, qr/^$err_re$/, 'failing errors');
59}
60
61{
62    # line 63
63    like("foo", "not a regex");
64    $TB->is_eq($out->read, <<OUT);
65not ok 2
66OUT
67
68    $TB->is_eq($err->read, <<OUT);
69#   Failed test at $0 line 63.
70#     'not a regex' doesn't look much like a regex to me.
71OUT
72
73}
74
75END {
76    # Test::More thinks it failed.  Override that.
77    $? = scalar grep { !$_ } $TB->summary;
78}
79