From ad021bfb7f2cc6ff5ff998e4e0efe2ba182cbbd5 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Sat, 11 Dec 2010 18:50:49 -0800
Subject: [PATCH] [perl #76026] match variables persist between calls to a sort
 sub
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

Since, for speed’s sake, pp_sort does not call PUSH/POPBLOCK for
every invocation of a sort subroutine, it fails to restore PL_curpm
after each call (POPBLOCK usually handles that). So the new values of
match vars like $1 when the sub returns are what it sees at the next
invocation.

This commit fixes this by resetting PL_curpm after each call to the
subroutine. There are actually three different functions for this
(S_sortcv*) so they all need modification.
---
 pp_sort.c   |  6 ++++++
 t/op/sort.t | 32 +++++++++++++++++++++++++++++++-
 2 files changed, 37 insertions(+), 1 deletion(-)

diff --git a/pp_sort.c b/pp_sort.c
index f96d568..055b3ac 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1745,6 +1745,7 @@ S_sortcv(pTHX_ SV *const a, SV *const b)
     const I32 oldsaveix = PL_savestack_ix;
     const I32 oldscopeix = PL_scopestack_ix;
     I32 result;
+    PMOP * const pm = PL_curpm;
  
     PERL_ARGS_ASSERT_SORTCV;
 
@@ -1760,6 +1761,7 @@ S_sortcv(pTHX_ SV *const a, SV *const b)
 	LEAVE;
     }
     leave_scope(oldsaveix);
+    PL_curpm = pm;
     return result;
 }
 
@@ -1771,6 +1773,7 @@ S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
     const I32 oldscopeix = PL_scopestack_ix;
     I32 result;
     AV * const av = GvAV(PL_defgv);
+    PMOP * const pm = PL_curpm;
 
     PERL_ARGS_ASSERT_SORTCV_STACKED;
 
@@ -1806,6 +1809,7 @@ S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
 	LEAVE;
     }
     leave_scope(oldsaveix);
+    PL_curpm = pm;
     return result;
 }
 
@@ -1817,6 +1821,7 @@ S_sortcv_xsub(pTHX_ SV *const a, SV *const b)
     const I32 oldscopeix = PL_scopestack_ix;
     CV * const cv=MUTABLE_CV(PL_sortcop);
     I32 result;
+    PMOP * const pm = PL_curpm;
 
     PERL_ARGS_ASSERT_SORTCV_XSUB;
 
@@ -1834,6 +1839,7 @@ S_sortcv_xsub(pTHX_ SV *const a, SV *const b)
 	LEAVE;
     }
     leave_scope(oldsaveix);
+    PL_curpm = pm;
     return result;
 }
 
diff --git a/t/op/sort.t b/t/op/sort.t
index 2119ead..73773b2 100644
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -6,7 +6,7 @@ BEGIN {
     require 'test.pl';
 }
 use warnings;
-plan( tests => 160 );
+plan( tests => 162 );
 
 # these shouldn't hang
 {
@@ -908,3 +908,33 @@ fresh_perl_is
   {},
  '[perl #77930] cx_stack reallocation during sort'
 ;
+
+# [perl #76026]
+# Match vars should not leak from one sort sub call to the next
+{
+  my $output = '';
+  sub soarter {
+    $output .= $1;
+    "Leakage" =~ /(.*)/;
+    1
+  }
+  sub soarterdd($$) {
+    $output .= $1;
+    "Leakage" =~ /(.*)/;
+    1
+  }
+
+  "Win" =~ /(.*)/;
+  my @b = sort soarter 0..2;
+
+  like $output, qr/^(?:Win)+\z/,
+   "Match vars do not leak from one plain sort sub to the next";
+
+  $output = '';
+
+  "Win" =~ /(.*)/;
+  @b = sort soarterdd 0..2;
+
+  like $output, qr/^(?:Win)+\z/,
+   'Match vars do not leak from one $$ sort sub to the next';
+}
-- 
2.7.4