Gecko [ www.blackthorn-inc.com ]

Linux cpanel2.daytoncreative.net 2.6.32-754.29.2.el6.x86_64 #1 SMP Tue May 12 17:39:04 UTC 2020 x86_64
Apache/2.4.43 (cPanel) OpenSSL/1.1.1g mod_bwlimited/1.4
Server IP : 70.62.220.67 & Your IP : 216.73.216.193
Domains : Cant Read [ /etc/named.conf ]
User : michaelgreg

Name	Size	Permission	Date
charset.t	13.16 KB	-r--r--r--	2014-12-27 11:49
fold_grind.t	39.63 KB	-r--r--r--	2014-12-27 12:37
no_utf8_pm.t	500 B	-r--r--r--	2014-12-27 11:49
overload.t	5.94 KB	-r--r--r--	2014-12-27 11:49
pat.t	48.6 KB	-r--r--r--	2015-01-24 15:03
pat_advanced.t	87.75 KB	-r--r--r--	2014-12-27 11:49
pat_advanced_thr.t	56 B	-r--r--r--	2014-12-27 11:49
pat_psycho.t	6.42 KB	-r--r--r--	2014-12-27 12:37
pat_psycho_thr.t	56 B	-r--r--r--	2014-12-27 11:49
pat_re_eval.t	37.05 KB	-r--r--r--	2014-12-27 11:49
pat_re_eval_thr.t	56 B	-r--r--r--	2014-12-27 11:49
pat_rt_report.t	36.98 KB	-r--r--r--	2014-12-27 11:49
pat_rt_report_thr.t	56 B	-r--r--r--	2014-12-27 11:49
pat_special_cc.t	1.64 KB	-r--r--r--	2014-12-27 11:49
pat_special_cc_thr.t	56 B	-r--r--r--	2014-12-27 11:49
pat_thr.t	56 B	-r--r--r--	2014-12-27 11:49
pos.t	957 B	-r--r--r--	2014-12-27 11:49
qr-72922.t	1.12 KB	-r--r--r--	2014-12-27 11:49
qr.t	1.95 KB	-r--r--r--	2014-12-27 11:49
qr_gc.t	416 B	-r--r--r--	2014-12-27 11:49
qrstack.t	191 B	-r--r--r--	2014-12-27 11:49
re_tests	62.97 KB	-r--r--r--	2014-12-27 11:49
recompile.t	4.63 KB	-r--r--r--	2014-12-27 11:49
reg_60508.t	687 B	-r--r--r--	2014-12-27 11:49
reg_email.t	3.33 KB	-r--r--r--	2014-12-27 11:49
reg_email_thr.t	56 B	-r--r--r--	2014-12-27 11:49
reg_eval.t	2.35 KB	-r--r--r--	2014-12-27 11:49
reg_eval_scope.t	8.85 KB	-r--r--r--	2014-12-27 11:49
reg_fold.t	6.14 KB	-r--r--r--	2014-12-27 11:49
reg_mesg.t	24.47 KB	-r--r--r--	2014-12-27 11:49
reg_namedcapture.t	760 B	-r--r--r--	2014-12-27 11:49
reg_nc_tie.t	2.22 KB	-r--r--r--	2014-12-27 11:49
reg_pmod.t	2.1 KB	-r--r--r--	2014-12-27 11:49
reg_posixcc.t	4.92 KB	-r--r--r--	2014-12-27 11:49
regex_sets.t	4.62 KB	-r--r--r--	2014-12-27 11:49
regex_sets_compat.t	492 B	-r--r--r--	2014-12-27 11:49
regexp.t	14.42 KB	-r--r--r--	2014-12-27 11:49
regexp_noamp.t	257 B	-r--r--r--	2014-12-27 11:49
regexp_notrie.t	275 B	-r--r--r--	2014-12-27 11:49
regexp_qr.t	194 B	-r--r--r--	2014-12-27 11:49
regexp_qr_embed.t	209 B	-r--r--r--	2014-12-27 11:49
regexp_qr_embed_thr.t	235 B	-r--r--r--	2014-12-27 11:49
regexp_trielist.t	289 B	-r--r--r--	2014-12-27 11:49
regexp_unicode_prop.t	11.15 KB	-r--r--r--	2014-12-27 11:49
regexp_unicode_prop_thr.t	56 B	-r--r--r--	2014-12-27 11:49
rt122747.t	555 B	-r--r--r--	2015-01-10 12:06
rxcode.t	3.15 KB	-r--r--r--	2015-01-11 13:46
subst.t	24.25 KB	-r--r--r--	2014-12-27 11:49
substT.t	170 B	-r--r--r--	2014-12-27 11:49
subst_amp.t	1.45 KB	-r--r--r--	2014-12-27 11:49
subst_wamp.t	211 B	-r--r--r--	2014-12-27 11:49
uniprops.t	543 B	-r--r--r--	2014-12-27 12:37

Rename

#!./perl

BEGIN {
    chdir 't' if -d 't';
    @INC = '../lib';
    require './test.pl';
}

use strict;
use warnings;

our @tests = (
    # /p      Pattern   PRE     MATCH   POST
    [ '/p',   "345",    "012-", "345",  "-6789"],
    [ '/$r/p',"345",    "012-", "345",  "-6789"],
    [ '(?p)', "345",    "012-", "345",  "-6789"],
    [ '(?p:)',"345",    "012-", "345",  "-6789"],
    [ '',     "(345)",  undef,  undef,  undef ],
    [ '',     "345",    undef,  undef,  undef ],
);

plan tests => 14 * @tests + 4;
my $W = "";

$SIG{__WARN__} = sub { $W.=join("",@_); };
sub _u($$) { "$_[0] is ".(defined $_[1] ? "'$_[1]'" : "undef") }

foreach my $test (@tests) {
    my ($p, $pat,$l,$m,$r) = @$test;
    my $qr = qr/$pat/;
    for my $sub (0,1) {
	my $test_name = $p eq '/p'   ? "/$pat/p"
		      : $p eq '/$r/p'? $p
		      : $p eq '(?p)' ? "/(?p)$pat/"
		      : $p eq '(?p:)'? "/(?p:$pat)/"
		      :                "/$pat/";
	$test_name = "s$test_name" if $sub;

#
	# Cannot use if/else due to the scope invalidating ${^MATCH} and friends.
	#
	$_ = '012-345-6789';
	my $ok =
		$sub ?
			(   $p eq '/p'   ? s/$pat/abc/p
			  : $p eq '/$r/p'? s/$qr/abc/p
			  : $p eq '(?p)' ? s/(?p)$pat/abc/
			  : $p eq '(?p:)'? s/(?p:$pat)/abc/
			  :                s/$pat/abc/
			)
		     :
			(   $p eq '/p'   ? /$pat/p
			  : $p eq '/$r/p'? /$qr/p
			  : $p eq '(?p)' ? /(?p)$pat/
			  : $p eq '(?p:)'? /(?p:$pat)/
			  :                /$pat/
			);
	ok $ok, $test_name;
	SKIP: {
	    skip "/$pat/$p failed to match", 6
		unless $ok;
	    is(${^PREMATCH},  $l,_u "$test_name: ^PREMATCH",$l);
	    is(${^MATCH},     $m,_u "$test_name: ^MATCH",$m );
	    is(${^POSTMATCH}, $r,_u "$test_name: ^POSTMATCH",$r );
	    is(length ${^PREMATCH}, length $l, "$test_name: ^PREMATCH length");
	    is(length ${^MATCH},    length $m, "$test_name: ^MATCH length");
	    is(length ${^POSTMATCH},length $r, "$test_name: ^POSTMATCH length");
	}
    }
}
is($W,"","No warnings should be produced");
ok(!defined ${^MATCH}, "No /p in scope so ^MATCH is undef");

#RT 117135

{
    my $m;
    ok("a"=~ /(?p:a(?{ $m = ${^MATCH} }))/, '(?{})');
    is($m, 'a', '(?{}) ^MATCH');
}