[perl.git] branch blead, updated. v5.13.7-406-gad021bf

[Father Chrysostomos]

In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/ad021bfb7f2cc6ff5ff998e4e0efe2ba182cbbd5?hp=4c9d53d59a35f57a9c3f30e6f419076cd0cb676e>

- Log -----------------------------------------------------------------
commit ad021bfb7f2cc6ff5ff998e4e0efe2ba182cbbd5
Author: Father Chrysostomos <spr...@cpan.org>
Date:   Sat Dec 11 18:50:49 2010 -0800

    [perl #76026] match variables persist between calls to a sort sub
    
    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.
-----------------------------------------------------------------------

Summary of changes:
 pp_sort.c   |    6 ++++++
 t/op/sort.t |   32 +++++++++++++++++++++++++++++++-
 2 files changed, 37 insertions(+), 1 deletions(-)

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';
+}

--
Perl5 Master Repository