Teach t/50-num_buff/*.t about perl 5.17.4 and newer

This fixes RT #92118.

diff --git a/t/50-num_buff/FETCH.t b/t/50-num_buff/FETCH.t
index 39d3f6ce3cc08fe7740bfd99fc01b30aa83af022..4c2ab04abb381211510de8635bc611bc39e4f1b3 100644 (file)
--- a/t/50-num_buff/FETCH.t
+++ b/t/50-num_buff/FETCH.t
@@ -1,6 +1,25 @@
 use strict;
 use Test::More tests => 7;
 
+
+my %rx_idx;
+BEGIN {
+    %rx_idx = (
+        q[$`] => -2,
+        q[$'] => -1,
+        q[$&] => 0,
+    );
+    if ("$]" >= 5.017_004) {
+        $rx_idx{q[${^PREMATCH}]}  = -5;
+        $rx_idx{q[${^POSTMATCH}]} = -4;
+        $rx_idx{q[${^MATCH}]}     = -3;
+    } else {
+        $rx_idx{q[${^PREMATCH}]}  = $rx_idx{q[$`]};
+        $rx_idx{q[${^POSTMATCH}]} = $rx_idx{q[$']};
+        $rx_idx{q[${^MATCH}]}     = $rx_idx{q[$&]};
+    }
+}
+
 use re::engine::Plugin (
     exec => sub {
         my $re = shift;
@@ -9,13 +28,25 @@ use re::engine::Plugin (
             FETCH => sub {
                 my ($re, $paren) = @_;
 
-                my %ret = (
-                    -2 => 10,
-                    -1 => 20,
-                     0 => 30,
-                     1 => 40,
+                my %exp = (
+                    q[$`]            => 10,
+                    q[${^PREMATCH}]  => 10,
+                    q[$']            => 20,
+                    q[${^POSTMATCH}] => 20,
+                    q[$&]            => 30,
+                    q[${^MATCH}]     => 30,
+                    1                => 40,
                 );
 
+                my %ret;
+                for (keys %exp) {
+                    if (exists $rx_idx{$_}) {
+                        $ret{$rx_idx{$_}} = $exp{$_};
+                    } else {
+                        $ret{$_}          = $exp{$_};
+                    }
+                }
+
                 $ret{$paren};
             }
         );
@@ -26,10 +57,10 @@ use re::engine::Plugin (
 
 "a" =~ /a/;
 
-is($`, 10, '$`');
-is(${^PREMATCH}, 10, '${^PREMATCH}');
-is($', 20, q($'));
+is($`,            10, '$`');
+is(${^PREMATCH},  10, '${^PREMATCH}');
+is($',            20, q($'));
 is(${^POSTMATCH}, 20, '${^POSTMATCH}');
-is($&, 30, '$&');
-is(${^MATCH}, 30, '${^MATCH}');
-is($1, 40, '$1');
+is($&,            30, '$&');
+is(${^MATCH},     30, '${^MATCH}');
+is($1,            40, '$1');

diff --git a/t/50-num_buff/STORE.t b/t/50-num_buff/STORE.t
index 3d693a0d8be1c813fe4293a8f29c69ff28bd125b..578011705f616c5c3ffcefc575a29c62a8d9827c 100644 (file)
--- a/t/50-num_buff/STORE.t
+++ b/t/50-num_buff/STORE.t
@@ -1,18 +1,47 @@
 use strict;
 use Test::More tests => 14;
 
+my %rx_idx;
+BEGIN {
+    %rx_idx = (
+        q[$`] => -2,
+        q[$'] => -1,
+        q[$&] => 0,
+    );
+    if ("$]" >= 5.019_004) {
+        # This should be the case since 5.17.4 but there's a bug in perl that
+        # was fixed in 5.19.4 which caused the FETCH callback to get the old
+        # indices.
+        $rx_idx{q[${^PREMATCH}]}  = -5;
+        $rx_idx{q[${^POSTMATCH}]} = -4;
+        $rx_idx{q[${^MATCH}]}     = -3;
+    } else {
+        $rx_idx{q[${^PREMATCH}]}  = $rx_idx{q[$`]};
+        $rx_idx{q[${^POSTMATCH}]} = $rx_idx{q[$']};
+        $rx_idx{q[${^MATCH}]}     = $rx_idx{q[$&]};
+    }
+}
+
 use re::engine::Plugin (
     exec => sub {
         my $re = shift;
 
+        if ("$]" >= 5.017_004) {
+            my %full_name_map = (
+                -2 => -5,
+                -1 => -4,
+                 0 => -3,
+            );
+        }
+
         $re->stash( [
-            [ -2, "a" ],
-            [ -2, "a" ],
-            [ -1, "o" ],
-            [ -1, "o" ],
-            [  0, "e" ],
-            [  0, "e" ],
-            [  1, "u" ],
+            [ q[$`],            "a" ],
+            [ q[${^PREMATCH}],  "a" ],
+            [ q[$'],            "o" ],
+            [ q[${^POSTMATCH}], "o" ],
+            [ q[$&],            "e" ],
+            [ q[${^MATCH}],     "e" ],
+            [ \1,               "u" ],
         ]);
 
         $re->num_captures(
@@ -20,8 +49,18 @@ use re::engine::Plugin (
                 my ($re, $paren, $sv) = @_;
                 my $test = shift @{ $re->stash };
 
-                is($paren, $test->[0]);
-                is($sv, $test->[1]);
+                my $desc;
+                my $idx = $test->[0];
+                if (ref $idx) {
+                    $idx  = $$idx;
+                    $desc = "STORE \$$idx";
+                } else {
+                    $desc = "STORE $idx";
+                    $idx  = $rx_idx{$idx};
+                }
+
+                is($paren, $idx,       "$desc (index)");
+                is($sv,    $test->[1], "$desc (value)");
             },
         );