1#!./perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    require './test.pl';
6    set_up_inc('../lib');
7}
8
9use strict;
10use warnings;
11
12our @tests = (
13    # /p      Pattern   PRE     MATCH   POST
14    [ '/p',   "345",    "012-", "345",  "-6789"],
15    [ '/$r/p',"345",    "012-", "345",  "-6789"],
16    [ '(?p)', "345",    "012-", "345",  "-6789"],
17    [ '(?p:)',"345",    "012-", "345",  "-6789"],
18    [ '',     "(345)",  undef,  undef,  undef ],
19    [ '',     "345",    undef,  undef,  undef ],
20);
21
22plan tests => 14 * @tests + 4;
23my $W = "";
24
25$SIG{__WARN__} = sub { $W.=join("",@_); };
26sub _u($$) { "$_[0] is ".(defined $_[1] ? "'$_[1]'" : "undef") }
27
28foreach my $test (@tests) {
29    my ($p, $pat,$l,$m,$r) = @$test;
30    my $qr = qr/$pat/;
31    for my $sub (0,1) {
32	my $test_name = $p eq '/p'   ? "/$pat/p"
33		      : $p eq '/$r/p'? $p
34		      : $p eq '(?p)' ? "/(?p)$pat/"
35		      : $p eq '(?p:)'? "/(?p:$pat)/"
36		      :                "/$pat/";
37	$test_name = "s$test_name" if $sub;
38
39	#
40	# Cannot use if/else due to the scope invalidating ${^MATCH} and friends.
41	#
42	$_ = '012-345-6789';
43	my $ok =
44		$sub ?
45			(   $p eq '/p'   ? s/$pat/abc/p
46			  : $p eq '/$r/p'? s/$qr/abc/p
47			  : $p eq '(?p)' ? s/(?p)$pat/abc/
48			  : $p eq '(?p:)'? s/(?p:$pat)/abc/
49			  :                s/$pat/abc/
50			)
51		     :
52			(   $p eq '/p'   ? /$pat/p
53			  : $p eq '/$r/p'? /$qr/p
54			  : $p eq '(?p)' ? /(?p)$pat/
55			  : $p eq '(?p:)'? /(?p:$pat)/
56			  :                /$pat/
57			);
58	ok $ok, $test_name;
59	SKIP: {
60	    skip "/$pat/$p failed to match", 6
61		unless $ok;
62	    is(${^PREMATCH},  $l,_u "$test_name: ^PREMATCH",$l);
63	    is(${^MATCH},     $m,_u "$test_name: ^MATCH",$m );
64	    is(${^POSTMATCH}, $r,_u "$test_name: ^POSTMATCH",$r );
65	    is(length ${^PREMATCH}, length $l, "$test_name: ^PREMATCH length");
66	    is(length ${^MATCH},    length $m, "$test_name: ^MATCH length");
67	    is(length ${^POSTMATCH},length $r, "$test_name: ^POSTMATCH length");
68	}
69    }
70}
71is($W,"","No warnings should be produced");
72ok(!defined ${^MATCH}, "No /p in scope so ^MATCH is undef");
73
74#RT 117135
75
76{
77    my $m;
78    ok("a"=~ /(?p:a(?{ $m = ${^MATCH} }))/, '(?{})');
79    is($m, 'a', '(?{}) ^MATCH');
80}
81