Separate handling of ${^PREMATCH} from $` etc

Currently the handling of getting the value, length etc of ${^PREMATCH}
etc is identical to that of $` etc.

Handle them separately, by adding RX_BUFF_IDX_CARET_PREMATCH etc
constants to the existing RX_BUFF_IDX_PREMATCH set.

This allows, when retrieving them, to always return undef if the current
match didn't use //p. Previously the result depended on stuff such
as whether the (non-//p) pattern included captures or not.

The documentation for ${^PREMATCH} etc states that it's only guaranteed to
return a defined value when the last pattern was //p.

As well as making things more consistent, this is a necessary
prerequisite for the following commit, which may not always copy the
whole string during a non-//p match.

1 files changed, 36 insertions, 22 deletions

diff --git a/t/re/reg_pmod.t b/t/re/reg_pmod.t
index 301aeefc6d..3190e03dde 100644
--- a/t/re/reg_pmod.t
+++ b/t/re/reg_pmod.t
@@ -11,38 +11,52 @@ use warnings;
 
 our @tests = (
     # /p      Pattern   PRE     MATCH   POST
-    [ '/p',   "456",    "123-", "456",  "-789"],
-    [ '(?p)', "456",    "123-", "456",  "-789"],
-    [ '',     "(456)",  "123-", "456",  "-789"],
-    [ '',     "456",    undef,  undef,  undef ],
+    [ '/p',   "345",    "12-", "345",  "-6789"],
+    [ '(?p)', "345",    "12-", "345",  "-6789"],
+    [ '',     "(345)",  undef,  undef,  undef ],
+    [ '',     "345",    undef,  undef,  undef ],
 );
 
-plan tests => 4 * @tests + 2;
+plan tests => 14 * @tests + 2;
 my $W = "";
 
 $SIG{__WARN__} = sub { $W.=join("",@_); };
 sub _u($$) { "$_[0] is ".(defined $_[1] ? "'$_[1]'" : "undef") }
 
-$_ = '123-456-789';
 foreach my $test (@tests) {
     my ($p, $pat,$l,$m,$r) = @$test;
-    my $test_name = $p eq '/p'   ? "/$pat/p"
-                  : $p eq '(?p)' ? "/(?p)$pat/"
-                  :                "/$pat/";
+    for my $sub (0,1) {
+	my $test_name = $p eq '/p'   ? "/$pat/p"
+		      : $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.
-    #
-    my $ok = ok $p eq '/p'   ? /$pat/p
-              : $p eq '(?p)' ? /(?p)$pat/
-              :                /$pat/
-              => $test_name;
-    SKIP: {
-        skip "/$pat/$p failed to match", 3
-            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 );
+	#
+	# Cannot use if/else due to the scope invalidating ${^MATCH} and friends.
+	#
+	$_ = '12-345-6789';
+	my $ok =
+		$sub ?
+			(   $p eq '/p'   ? s/$pat/abc/p
+			  : $p eq '(?p)' ? s/(?p)$pat/abc/
+			  :                s/$pat/abc/
+			)
+		     :
+			(   $p eq '/p'   ? /$pat/p
+			  : $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");