[perl #112184] Handle $^N in Perl_magic_set

$^N is a magical variable, like $1 and $2, with the usual ‘sv’
magic.  So it is handled by Perl_magic_get and Perl_magic_set.  But
Perl_magic_set didn’t have a case for it, so it simply ignored it and
did nothing, like a tied variable with an empty STORE method.

Now assigning to $^N has the same affect as assigned to the numbered
variable to which it corresponds.  If there is no corresponding cap-
ture from the last match, or in the absence of regexp plugins, it
croaks with ‘Modification of a read-only value’.

diff --git a/mg.c b/mg.c
index 03500da..9acd5d2 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -2519,11 +2519,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
       paren = atoi(mg->mg_ptr);
       setparen:
        if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
+      setparen_got_rx:
             CALLREG_NUMBUF_STORE((REGEXP * const)rx,paren,sv);
        } else {
             /* Croak with a READONLY error when a numbered match var is
              * set without a previous pattern match. Unless it's C<local $1>
              */
+      croakparen:
             if (!PL_localizing) {
                 Perl_croak_no_modify(aTHX);
             }
@@ -2598,6 +2600,10 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        Safefree(PL_inplace);
        PL_inplace = SvOK(sv) ? savesvpv(sv) : NULL;
        break;
+    case '\016':       /* ^N */
+       if (PL_curpm && (rx = PM_GETRE(PL_curpm))
+        && (paren = RX_LASTCLOSEPAREN(rx))) goto setparen_got_rx;
+       goto croakparen;
     case '\017':       /* ^O */
        if (*(mg->mg_ptr+1) == '\0') {
            Safefree(PL_osname);

diff --git a/t/re/pat.t b/t/re/pat.t
index faddbc5..882368e 100644 (file)
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -19,7 +19,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 472;  # Update this when adding/deleting tests.
+plan tests => 474;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -676,10 +676,11 @@ sub run_tests {
         is($#-, 1, $message);
     }
 
-    foreach ('$+[0] = 13', '$-[0] = 13', '@+ = (7, 6, 5)', '@- = qw (foo bar)') {
+    foreach ('$+[0] = 13', '$-[0] = 13', '@+ = (7, 6, 5)',
+            '@- = qw (foo bar)', '$^N = 42') {
        is(eval $_, undef);
         like($@, qr/^Modification of a read-only value attempted/,
-            'Elements of @- and @+ are read-only');
+            '$^N, @- and @+ are read-only');
     }
 
     {