Use OPpDEREF for lvalue sub, such that the flags contains the deref type, instead...

Also contains a test where using the opchain to determine the deref
type fails.

diff --git a/cop.h b/cop.h
index 6512451..8cd8a8a 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -643,7 +643,7 @@ struct block_format {
                   ? 0 : Perl_was_lvalue_sub(aTHX);                     \
        PUSHSUB_BASE(cx)                                                \
        cx->blk_u16 = PL_op->op_private &                               \
-                         (phlags|OPpENTERSUB_DEREF);                   \
+                         (phlags|OPpDEREF);                            \
     }
 
 /* variant for use by OP_DBSTATE, where op_private holds hint bits */

diff --git a/op.c b/op.c
index 50a6179..af67720 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2177,7 +2177,9 @@ Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)
            o->op_private &= ~1;
        }
        else if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV){
-           o->op_private |= OPpENTERSUB_DEREF;
+           o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
+                             : type == OP_RV2HV ? OPpDEREF_HV
+                             : OPpDEREF_SV);
            o->op_flags |= OPf_MOD;
        }
 

diff --git a/op.h b/op.h
index 70b6358..903f7cd 100644 (file)
--- a/op.h
+++ b/op.h
@@ -206,7 +206,7 @@ Deprecated.  Use C<GIMME_V> instead.
 #define OPpENTERSUB_DB         16      /* Debug subroutine. */
 #define OPpENTERSUB_HASTARG    4       /* Called from OP tree. */
 #define OPpENTERSUB_INARGS     1       /* Lval used as arg to a sub. */
-#define OPpENTERSUB_DEREF      32      /* Lval call that autovivifies. */
+/* used by OPpDEREF             (32|64) */
 /* used by HINT_STRICT_SUBS     2          */
   /* Mask for OP_ENTERSUB flags, the absence of which must be propagated
      in dynamic context */

diff --git a/pp_ctl.c b/pp_ctl.c
index 67b11e3..0d2aae1 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2365,24 +2365,15 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
            EXTEND(newsp,1);
            *++newsp = &PL_sv_undef;
        }
-       if (CxLVAL(cx) & OPpENTERSUB_DEREF) {
+       if (CxLVAL(cx) & OPpDEREF) {
            SvGETMAGIC(TOPs);
            if (!SvOK(TOPs)) {
-               U8 deref_type;
-               if (cx->blk_sub.retop->op_type == OP_RV2SV)
-                   deref_type = OPpDEREF_SV;
-               else if (cx->blk_sub.retop->op_type == OP_RV2AV)
-                   deref_type = OPpDEREF_AV;
-               else {
-                   assert(cx->blk_sub.retop->op_type == OP_RV2HV);
-                   deref_type = OPpDEREF_HV;
-               }
-               TOPs = vivify_ref(TOPs, deref_type);
+               TOPs = vivify_ref(TOPs, CxLVAL(cx) & OPpDEREF);
            }
        }
     }
     else if (gimme == G_ARRAY) {
-       assert (!(CxLVAL(cx) & OPpENTERSUB_DEREF));
+       assert (!(CxLVAL(cx) & OPpDEREF));
        if (ref || !CxLVAL(cx))
            while (++MARK <= SP)
                *++newsp =

diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t
index f34fab9..ce5da8d 100644 (file)
--- a/t/op/sub_lval.t
+++ b/t/op/sub_lval.t
@@ -3,7 +3,7 @@ BEGIN {
     @INC = '../lib';
     require './test.pl';
 }
-plan tests=>179;
+plan tests=>181;
 
 sub a : lvalue { my $a = 34; ${\(bless \$a)} }  # Return a temporary
 sub b : lvalue { ${\shift} }
@@ -880,6 +880,9 @@ for my $sub (sub :lvalue {$_}, sub :lvalue {return $_}) {
     undef $_;
     %{&$sub()} = (4,5);
     is join('-',%$_), '4-5', '%{func()} autovivification'.$suffix;
+    undef $_;
+    ${ (), &$sub()} = 4;
+    is $$_, 4, '${ (), func()} autovivification'      .$suffix;
 }
 continue { $suffix = ' (explicit return)' }