This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #113710] Make __SUB__ work in sort block
authorFather Chrysostomos <sprout@cpan.org>
Sat, 14 Jul 2012 07:07:03 +0000 (00:07 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 14 Jul 2012 07:07:03 +0000 (00:07 -0700)
When the peephole optimiser encounters a __SUB__, it looks to see
whether the current sub is clonable.  If it is not, it inlines the
__SUB__ as a const op.

This works most of the time.  A forward declaration will cause the sub
definition to reuse the existing stub.  When that happens, the sub
visible during compilation in PL_compcv is not the sub that the
op tree will finally be attached to.  But the peephole optimiser
is called after that, with PL_compcv set to the other CV (what
was a stub).

ck_sort was calling the peephole optimiser on the sort block ahead of
time.  So this caused __SUB__ to point to the wrong subroutine.

By removing the CALL_PEEP call from ck_sort and adding logic to the
peephole optimiser itself to traverse the sort block (it is not in the
usual op_next chain), this bug is eliminated.

I modified the DEFER macro to work as a single statement.  You don’t
want to know how much time I spent debugging the bus errors that were
occurring because if(foo) DEFER; didn’t do what I though.

It turns out that grepstart and mapstart, which also use ck_sort,
had their blocks go through the peephole optimiser twice, because
grepwhile already has special-casing in the peephole optimiser.

This also has the side-effect of making map and grep slightly more
efficient, in that they no longer execute a scope op (which is just
pp_null).  By temporarily disconnecting the subtree before running the
optimiser, ck_sort was hiding a possible optimisation (skipping the
scope op).

ext/B/t/f_map.t
ext/B/t/f_sort.t
op.c
t/op/current_sub.t

index 2fa2ec9..4506543 100644 (file)
@@ -247,7 +247,6 @@ checkOptree(note   => q{},
 # b      <@> stringify[t5] sK/1
 # c      <$> const[IV 1] s
 # d      <@> list lK
-# -      <@> scope lK
 #            goto 7
 # e  <0> pushmark s
 # f  <#> gv[*hash] s
@@ -268,7 +267,6 @@ EOT_EOT
 # b      <@> stringify[t3] sK/1
 # c      <$> const(IV 1) s
 # d      <@> list lK
-# -      <@> scope lK
 #            goto 7
 # e  <0> pushmark s
 # f  <$> gv(*hash) s
@@ -301,7 +299,6 @@ checkOptree(note   => q{},
 # b      <@> stringify[t5] sK/1
 # c      <$> const[IV 1] s
 # d      <@> list lKP
-# -      <@> scope lK
 #            goto 7
 # e  <0> pushmark s
 # f  <#> gv[*hash] s
@@ -322,7 +319,6 @@ EOT_EOT
 # b      <@> stringify[t3] sK/1
 # c      <$> const(IV 1) s
 # d      <@> list lKP
-# -      <@> scope lK
 #            goto 7
 # e  <0> pushmark s
 # f  <$> gv(*hash) s
@@ -354,7 +350,6 @@ checkOptree(note   => q{},
 # a      <1> lc[t4] sK/1
 # b      <$> const[IV 1] s
 # c      <@> list lK
-# -      <@> scope lK
 #            goto 7
 # d  <0> pushmark s
 # e  <#> gv[*hash] s
@@ -374,7 +369,6 @@ EOT_EOT
 # a      <1> lc[t2] sK/1
 # b      <$> const(IV 1) s
 # c      <@> list lK
-# -      <@> scope lK
 #            goto 7
 # d  <0> pushmark s
 # e  <$> gv(*hash) s
index 58a8cf2..f17976f 100644 (file)
@@ -520,7 +520,6 @@ checkOptree(name   => q{Compound sort/map Expression },
 # o      <1> rv2av[t4] sKR/1
 # p      <$> const[IV 0] s
 # q      <2> aelem sK/2
-# -      <@> scope lK
 #            goto l
 # r  <0> pushmark s
 # s  <#> gv[*new] s
@@ -555,7 +554,6 @@ EOT_EOT
 # o      <1> rv2av[t2] sKR/1
 # p      <$> const(IV 0) s
 # q      <2> aelem sK/2
-# -      <@> scope lK
 #            goto l
 # r  <0> pushmark s
 # s  <$> gv(*new) s
@@ -790,7 +788,6 @@ checkOptree(note   => q{},
 # 9      <#> gvsv[*_] s
 # a      <#> gvsv[*_] s
 # b      <2> eq sK/2
-# -      <@> scope sK
 #            goto 8
 # c  <@> sort lK/NUM
 # d  <0> pushmark s
@@ -810,7 +807,6 @@ EOT_EOT
 # 9      <$> gvsv(*_) s
 # a      <$> gvsv(*_) s
 # b      <2> eq sK/2
-# -      <@> scope sK
 #            goto 8
 # c  <@> sort lK/NUM
 # d  <0> pushmark s
@@ -869,7 +865,6 @@ checkOptree(note   => q{},
 # 8      <#> gvsv[*_] s
 # 9      <#> gvsv[*_] s
 # a      <2> eq sK/2
-# -      <@> scope sK
 #            goto 7
 # b  <@> sort K/NUM
 # c  <1> leavesub[1 ref] K/REFC,1
@@ -884,7 +879,6 @@ EOT_EOT
 # 8      <$> gvsv(*_) s
 # 9      <$> gvsv(*_) s
 # a      <2> eq sK/2
-# -      <@> scope sK
 #            goto 7
 # b  <@> sort K/NUM
 # c  <1> leavesub[1 ref] K/REFC,1
@@ -942,7 +936,6 @@ checkOptree(note   => q{},
 # 8      <#> gvsv[*_] s
 # 9      <#> gvsv[*_] s
 # a      <2> eq sK/2
-# -      <@> scope sK
 #            goto 7
 # b  <@> sort sK/NUM
 # c  <#> gvsv[*s] s
@@ -959,7 +952,6 @@ EOT_EOT
 # 8      <$> gvsv(*_) s
 # 9      <$> gvsv(*_) s
 # a      <2> eq sK/2
-# -      <@> scope sK
 #            goto 7
 # b  <@> sort sK/NUM
 # c  <$> gvsv(*s) s
diff --git a/op.c b/op.c
index d6cf1a2..c56cfc5 100644 (file)
--- a/op.c
+++ b/op.c
@@ -9198,7 +9198,6 @@ Perl_ck_sort(pTHX_ OP *o)
                    kid->op_next = 0;           /* just disconnect the leave */
                k = kLISTOP->op_first;
            }
-           CALL_PEEP(k);
 
            kid = firstkid;
            if (o->op_type == OP_SORT) {
@@ -10354,12 +10353,14 @@ S_inplace_aassign(pTHX_ OP *o) {
 #define MAX_DEFERRED 4
 
 #define DEFER(o) \
+  STMT_START { \
     if (defer_ix == (MAX_DEFERRED-1)) { \
        CALL_RPEEP(defer_queue[defer_base]); \
        defer_base = (defer_base + 1) % MAX_DEFERRED; \
        defer_ix--; \
     } \
-    defer_queue[(defer_base + ++defer_ix) % MAX_DEFERRED] = o;
+    defer_queue[(defer_base + ++defer_ix) % MAX_DEFERRED] = o; \
+  } STMT_END
 
 /* A peephole optimizer.  We visit the ops in the order they're to execute.
  * See the comments at the top of this file for more details about when
@@ -10651,8 +10652,17 @@ Perl_rpeep(pTHX_ register OP *o)
            break;
 
        case OP_SORT: {
+           OP *oright;
+
+           if (o->op_flags & OPf_STACKED) {
+               OP * const kid =
+                   cUNOPx(cLISTOP->op_first->op_sibling)->op_first;
+               if (kid->op_type == OP_SCOPE
+                || (kid->op_type == OP_NULL && kid->op_targ == OP_LEAVE))                  DEFER(kLISTOP->op_first);
+           }
+
            /* check that RHS of sort is a single plain array */
-           OP *oright = cUNOPo->op_first;
+           oright = cUNOPo->op_first;
            if (!oright || oright->op_type != OP_PUSHMARK)
                break;
 
index e72a0c5..8c82d11 100644 (file)
@@ -4,7 +4,7 @@ BEGIN {
     chdir 't';
     @INC = qw(../lib);
     require './test.pl';
-    plan (tests => 13);
+    plan (tests => 17);
 }
 
 is __SUB__, "__SUB__", '__SUB__ is a bareword outside of use feature';
@@ -45,3 +45,33 @@ BEGIN {
     return "begin 2" if @_;
     is &CORE::__SUB__->(0), "begin 2", 'in BEGIN block via & (unoptimised)'
 }
+
+sub bar;
+sub bar {
+    () = sort {
+          is  CORE::__SUB__, \&bar,   'in sort block in sub with forw decl'
+         } 1,2;
+}
+bar();
+sub bur;
+sub bur {
+    () = sort {
+          is &CORE::__SUB__, \&bur, '& in sort block in sub with forw decl'
+         } 1,2;
+}
+bur();
+
+sub squog;
+sub squog {
+    grep { is  CORE::__SUB__, \&squog,
+          'in grep block in sub with forw decl'
+    } 1;
+}
+squog();
+sub squag;
+sub squag {
+    grep { is &CORE::__SUB__, \&squag,
+          '& in grep block in sub with forw decl'
+    } 1;
+}
+squag();