[perl.git] branch blead, updated. v5.21.3-693-g2872f91

[Father Chrysostomos]

In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/2872f91877d2b05fa39d7cd030f43cd2ebc6b046?hp=a65806443486002454b94ddaa28f8c9cb2eb9859>

- Log -----------------------------------------------------------------
commit 2872f91877d2b05fa39d7cd030f43cd2ebc6b046
Author: Father Chrysostomos <spr...@cpan.org>
Date:   Tue Sep 16 13:10:38 2014 -0700

    Make sort bareword respect lexical subs
    
    —something I completely missed when implementing them.
-----------------------------------------------------------------------

Summary of changes:
 op.c          | 27 +++++++++++++++++++++++++++
 t/op/lexsub.t | 13 +++++++++----
 2 files changed, 36 insertions(+), 4 deletions(-)

diff --git a/op.c b/op.c
index 9b1ef8c..4ace886 100644
--- a/op.c
+++ b/op.c
@@ -9971,6 +9971,33 @@ Perl_ck_sort(pTHX_ OP *o)
            kid->op_next = kid;
            o->op_flags |= OPf_SPECIAL;
        }
+       else if (kid->op_type == OP_CONST
+             && kid->op_private & OPpCONST_BARE) {
+           char tmpbuf[256];
+           STRLEN len;
+           PADOFFSET off;
+           const char * const name = SvPV(kSVOP_sv, len);
+           *tmpbuf = '&';
+           assert (len < 256);
+           Copy(name, tmpbuf+1, len, char);
+           off = pad_findmy_pvn(tmpbuf, len+1, SvUTF8(kSVOP_sv));
+           if (off != NOT_IN_PAD) {
+               if (PAD_COMPNAME_FLAGS_isOUR(off)) {
+                   SV * const new =
+                       newSVhek(HvNAME_HEK(PAD_COMPNAME_OURSTASH(off)));
+                   sv_catpvs(new, "::");
+                   sv_catsv(new, kSVOP_sv);
+                   SvREFCNT_dec_NN(kSVOP_sv);
+                   kSVOP->op_sv = new;
+               }
+               else {
+                   OP * const new = newOP(OP_PADCV, 0);
+                   new->op_targ = off;
+                   cUNOPx(firstkid)->op_first = new;
+                   op_free(kid);
+               }
+           }
+       }
 
        firstkid = OP_SIBLING(firstkid);
     }
diff --git a/t/op/lexsub.t b/t/op/lexsub.t
index 91bb15f..81addda 100644
--- a/t/op/lexsub.t
+++ b/t/op/lexsub.t
@@ -7,7 +7,7 @@ BEGIN {
     *bar::is = *is;
     *bar::like = *like;
 }
-plan 141;
+plan 142;
 
 # -------------------- Errors with feature disabled -------------------- #
 
@@ -111,6 +111,14 @@ sub F::h { 4242 }
 our sub j;
 is j
   =>, 'j', 'name_of_our_sub <newline> =>  is parsed properly';
+sub _cmp { $a cmp $b }
+sub bar::_cmp { $b cmp $a }
+{
+  package bar;
+  our sub _cmp;
+  package main;
+  is join(" ", sort _cmp split //, 'oursub'), 'u u s r o b', 'sort our_sub'
+}
 
 # -------------------- state -------------------- #
 
@@ -384,9 +392,7 @@ is runperl(switches => ['-lXMfeature=:all'],
   state sub x { is +(caller 0)[3], 'x', 'state sub name in caller' }
   x
 }
-sub _cmp { $a cmp $b }
 {
-  local $::TODO = ' ';
   state sub _cmp { $b cmp $a }
   is join(" ", sort _cmp split //, 'lexsub'), 'x u s l e b',
     'sort state_sub LIST'
@@ -749,7 +755,6 @@ is runperl(switches => ['-lXMfeature=:all'],
   x
 }
 {
-  local $::TODO = ' ';
   my sub _cmp { $b cmp $a }
   is join(" ", sort _cmp split //, 'lexsub'), 'x u s l e b',
     'sort my_sub LIST'

--
Perl5 Master Repository