[perl #109264] ->method(my(...)) forcing lvalue cx

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 3af6ee7..09f45d0 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1167,14 +1167,6 @@ Perl_scalarvoid(pTHX_ OP *o)
            no_bareword_allowed(o);
        else {
            if (ckWARN(WARN_VOID)) {
            no_bareword_allowed(o);
        else {
            if (ckWARN(WARN_VOID)) {

-               if (SvOK(sv)) {
-                   SV* msv = sv_2mortal(Perl_newSVpvf(aTHX_
-                               "a constant (%"SVf")", sv));
-                   useless = SvPV_nolen(msv);
-                    useless_is_utf8 = SvUTF8(msv);
-               }
-               else
-                   useless = "a constant (undef)";

                /* don't warn on optimised away booleans, eg 
                 * use constant Foo, 5; Foo || print; */
                if (cSVOPo->op_private & OPpCONST_SHORTCIRCUIT)
                /* don't warn on optimised away booleans, eg 
                 * use constant Foo, 5; Foo || print; */
                if (cSVOPo->op_private & OPpCONST_SHORTCIRCUIT)


@@ -1196,7 +1188,24 @@ Perl_scalarvoid(pTHX_ OP *o)
                        strnEQ(maybe_macro, "ds", 2) ||
                        strnEQ(maybe_macro, "ig", 2))
                            useless = NULL;
                        strnEQ(maybe_macro, "ds", 2) ||
                        strnEQ(maybe_macro, "ig", 2))
                            useless = NULL;

+                   else {
+                       SV * const dsv = newSVpvs("");
+                       SV* msv = sv_2mortal(Perl_newSVpvf(aTHX_
+                                   "a constant (%s)",
+                                   pv_pretty(dsv, maybe_macro, SvCUR(sv), 32, NULL, NULL,
+                                           PERL_PV_PRETTY_DUMP | PERL_PV_ESCAPE_NOCLEAR | PERL_PV_ESCAPE_UNI_DETECT )));
+                       SvREFCNT_dec(dsv);
+                       useless = SvPV_nolen(msv);
+                       useless_is_utf8 = SvUTF8(msv);
+                   }

                }
                }

+               else if (SvOK(sv)) {
+                   SV* msv = sv_2mortal(Perl_newSVpvf(aTHX_
+                               "a constant (%"SVf")", sv));
+                   useless = SvPV_nolen(msv);
+               }
+               else
+                   useless = "a constant (undef)";

            }
        }
        op_null(o);             /* don't execute or even remember it */
            }
        }
        op_null(o);             /* don't execute or even remember it */


@@ -2393,6 +2402,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
         OP *kid;
        for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
            my_kid(kid, attrs, imopsp);
         OP *kid;
        for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
            my_kid(kid, attrs, imopsp);

+       return o;

     } else if (type == OP_UNDEF
 #ifdef PERL_MAD
               || type == OP_STUB
     } else if (type == OP_UNDEF
 #ifdef PERL_MAD
               || type == OP_STUB


@@ -9136,7 +9146,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
                continue;
            case '_':
                /* _ must be at the end */
                continue;
            case '_':
                /* _ must be at the end */

-               if (proto[1] && proto[1] != ';')
+               if (proto[1] && !strchr(";@%", proto[1]))

                    goto oops;
            case '$':
                proto++;
                    goto oops;
            case '$':
                proto++;