1# qr// was introduced in 5.004-devel.  Skip this test if we're not
2# of high enough version.
3BEGIN {
4    if( $] < 5.005 ) {
5        print "1..0 # Skipped Test requires qr//\n";
6        exit(0);
7    }
8}
9
10BEGIN {
11    if( $ENV{PERL_CORE} ) {
12        chdir 't';
13        @INC = ('../lib', 'lib');
14    }
15    else {
16        unshift @INC, 't/lib';
17    }
18}
19
20# There was a bug with like() involving a qr// not failing properly.
21# This tests against that.
22
23use strict;
24
25
26# Can't use Test.pm, that's a 5.005 thing.
27package My::Test;
28
29# This has to be a require or else the END block below runs before
30# Test::Builder's own and the ending diagnostics don't come out right.
31require Test::Builder;
32my $TB = Test::Builder->create;
33$TB->plan(tests => 2);
34
35
36require Test::Simple::Catch;
37my($out, $err) = Test::Simple::Catch::caught();
38local $ENV{HARNESS_ACTIVE} = 0;
39
40
41package main;
42
43require Test::More;
44Test::More->import(tests => 1);
45
46eval q{ like( "foo", qr/that/, 'is foo like that' ); };
47
48
49END {
50    $TB->is_eq($$out, <<OUT, 'failing output');
511..1
52not ok 1 - is foo like that
53OUT
54
55    my $err_re = <<ERR;
56#   Failed test 'is foo like that'
57#   in .* at line 1\.
58#                   'foo'
59#     doesn't match '\\(\\?-xism:that\\)'
60# Looks like you failed 1 test of 1\\.
61ERR
62
63
64    $TB->like($$err, qr/^$err_re$/, 'failing errors');
65
66    exit(0);
67}
68