Commit | Line | Data |
3f2ec160 |
1 | # qr// was introduced in 5.004-devel. Skip this test if we're not |
2 | # of high enough version. |
3 | BEGIN { |
4 | if( $] < 5.005 ) { |
30e302f8 |
5 | print "1..0 # Skipped Test requires qr//\n"; |
3f2ec160 |
6 | exit(0); |
7 | } |
8 | } |
9 | |
a9153838 |
10 | BEGIN { |
11 | if( $ENV{PERL_CORE} ) { |
12 | chdir 't'; |
13 | @INC = ('../lib', 'lib'); |
14 | } |
15 | else { |
16 | unshift @INC, 't/lib'; |
17 | } |
18 | } |
3f2ec160 |
19 | |
20 | # There was a bug with like() involving a qr// not failing properly. |
21 | # This tests against that. |
22 | |
33459055 |
23 | use strict; |
33459055 |
24 | |
25 | require Test::Simple::Catch; |
26 | my($out, $err) = Test::Simple::Catch::caught(); |
30e302f8 |
27 | local $ENV{HARNESS_ACTIVE} = 0; |
33459055 |
28 | |
29 | |
3f2ec160 |
30 | # Can't use Test.pm, that's a 5.005 thing. |
31 | package My::Test; |
32 | |
33 | print "1..2\n"; |
34 | |
35 | my $test_num = 1; |
36 | # Utility testing functions. |
37 | sub ok ($;$) { |
38 | my($test, $name) = @_; |
1af51bd3 |
39 | my $ok = ''; |
40 | $ok .= "not " unless $test; |
41 | $ok .= "ok $test_num"; |
42 | $ok .= " - $name" if defined $name; |
43 | $ok .= "\n"; |
44 | print $ok; |
3f2ec160 |
45 | $test_num++; |
46 | } |
47 | |
48 | |
49 | package main; |
d020a79a |
50 | |
3f2ec160 |
51 | require Test::More; |
3f2ec160 |
52 | Test::More->import(tests => 1); |
53 | |
54 | eval q{ like( "foo", qr/that/, 'is foo like that' ); }; |
55 | |
56 | |
57 | END { |
58 | My::Test::ok($$out eq <<OUT, 'failing output'); |
59 | 1..1 |
60 | not ok 1 - is foo like that |
61 | OUT |
62 | |
63 | my $err_re = <<ERR; |
64 | # Failed test \\(.*\\) |
65 | # 'foo' |
66 | # doesn't match '\\(\\?-xism:that\\)' |
30e302f8 |
67 | # Looks like you failed 1 test of 1\\. |
3f2ec160 |
68 | ERR |
69 | |
70 | |
71 | My::Test::ok($$err =~ /^$err_re$/, 'failing errors'); |
72 | |
73 | exit(0); |
74 | } |