From d9bad346a16eb87a6306ab3d32ca301cc10d1323 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Tue, 24 Apr 2012 13:31:45 -0700
Subject: [PATCH] [perl #112184] Handle $^N in Perl_magic_set
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

$^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’.
---
 mg.c       | 6 ++++++
 t/re/pat.t | 7 ++++---
 2 files changed, 10 insertions(+), 3 deletions(-)

diff --git a/mg.c b/mg.c
index 03500da..9acd5d2 100644
--- 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
--- 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');
     }
 
     {
-- 
1.8.3.1