aelemfast optimization opclass problem (c.f. [perl #38279])

Message-ID: <17365.51166.604020.571992@conquest.OCF.Berkeley.EDU>

p4raw-id: //depot/perl@26943

diff --git a/MANIFEST b/MANIFEST
index 048efe8..33990d8 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -126,7 +126,8 @@ ext/B/t/OptreeCheck.pm              optree comparison tool
 ext/B/t/optree_check.t         test OptreeCheck apparatus
 ext/B/t/optree_concise.t       more B::Concise tests
 ext/B/t/optree_constants.t     B::Concise rendering of optimized constant subs
-ext/B/t/optree_samples.t       various basic codes: if for while 
+ext/B/t/optree_misc.t          misc optree tests
+ext/B/t/optree_samples.t       various basic codes: if for while
 ext/B/t/optree_sort.t          inplace sort optimization regression
 ext/B/t/optree_specials.t      BEGIN, END, etc code
 ext/B/t/optree_varinit.t       my,our,local var init optimization

diff --git a/ext/B/B.xs b/ext/B/B.xs
index 04422b3..de7993a 100644 (file)
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -112,9 +112,20 @@ cc_opclass(pTHX_ const OP *o)
     if (o->op_type == OP_SASSIGN)
        return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
 
+    if (o->op_type == OP_AELEMFAST) {
+       if (o->op_flags & OPf_SPECIAL)
+           return OPc_BASEOP;
+       else
+#ifdef USE_ITHREADS
+           return OPc_PADOP;
+#else
+           return OPc_SVOP;
+#endif
+    }
+    
 #ifdef USE_ITHREADS
     if (o->op_type == OP_GV || o->op_type == OP_GVSV ||
-       o->op_type == OP_AELEMFAST || o->op_type == OP_RCATLINE)
+       o->op_type == OP_RCATLINE)
        return OPc_PADOP;
 #endif
 

diff --git a/ext/B/t/optree_misc.t b/ext/B/t/optree_misc.t
new file mode 100644 (file)
index 0000000..96a232c
--- /dev/null
+++ b/ext/B/t/optree_misc.t
@@ -0,0 +1,72 @@
+#!perl
+
+BEGIN {
+    if ($ENV{PERL_CORE}){
+       chdir('t') if -d 't';
+       @INC = ('.', '../lib', '../ext/B/t');
+    } else {
+       unshift @INC, 't';
+       push @INC, "../../t";
+    }
+    require Config;
+    if (($Config::Config{'extensions'} !~ /\bB\b/) ){
+        print "1..0 # Skip -- Perl configured without B module\n";
+        exit 0;
+    }
+}
+use OptreeCheck;
+use Config;
+plan tests => 1;
+
+SKIP: {
+skip "no perlio in this build", 1 unless $Config::Config{useperlio};
+
+# The regression this is testing is that the first aelemfast, derived
+# from a lexical array, is supposed to be a BASEOP "<0>", while the
+# second, from a global, is an SVOP "<$>" or a PADOP "<#>" depending
+# on threading. In buggy versions, both showed up as SVOPs/PADOPs. See
+# B.xs:cc_opclass() for the relevant code.
+
+checkOptree ( name     => 'OP_AELEMFAST opclass',
+             code      => sub { my @x; our @y; $x[0] + $y[0]},
+             expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
+# a  <1> leavesub[1 ref] K/REFC,1 ->(end)
+# -     <@> lineseq KP ->a
+# 1        <;> nextstate(main 634 optree_misc.t:25) v ->2
+# 2        <0> padav[@x:634,636] vM/LVINTRO ->3
+# 3        <;> nextstate(main 635 optree_misc.t:25) v ->4
+# 5        <1> rv2av[t4] vK/OURINTR,1 ->6
+# 4           <#> gv[*y] s ->5
+# 6        <;> nextstate(main 636 optree_misc.t:25) v ->7
+# 9        <2> add[t6] sK/2 ->a
+# -           <1> ex-aelem sK/2 ->8
+# 7              <0> aelemfast[@x:634,636] sR* ->8
+# -              <0> ex-const s ->-
+# -           <1> ex-aelem sK/2 ->9
+# -              <1> ex-rv2av sKR/1 ->-
+# 8                 <#> aelemfast[*y] s ->9
+# -              <0> ex-const s ->-
+EOT_EOT
+# a  <1> leavesub[1 ref] K/REFC,1 ->(end)
+# -     <@> lineseq KP ->a
+# 1        <;> nextstate(main 634 optree_misc.t:27) v ->2
+# 2        <0> padav[@x:634,636] vM/LVINTRO ->3
+# 3        <;> nextstate(main 635 optree_misc.t:27) v ->4
+# 5        <1> rv2av[t3] vK/OURINTR,1 ->6
+# 4           <$> gv(*y) s ->5
+# 6        <;> nextstate(main 636 optree_misc.t:27) v ->7
+# 9        <2> add[t4] sK/2 ->a
+# -           <1> ex-aelem sK/2 ->8
+# 7              <0> aelemfast[@x:634,636] sR* ->8
+# -              <0> ex-const s ->-
+# -           <1> ex-aelem sK/2 ->9
+# -              <1> ex-rv2av sKR/1 ->-
+# 8                 <$> aelemfast(*y) s ->9
+# -              <0> ex-const s ->-
+EONT_EONT
+
+
+} #skip
+
+__END__
+