fix a couple of -Dmad compiler warnings

[perl5.git] / pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index 6f48d5a..031c2cf 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -112,6 +112,7 @@ PP(pp_and)
 PP(pp_sassign)
 {
     dVAR; dSP; dPOPTOPssrl;
+    U32 wasfake = 0;
 
     if (PL_op->op_private & OPpASSIGN_BACKWARDS) {
        SV * const temp = left;
@@ -197,7 +198,14 @@ PP(pp_sassign)
        }
 
     }
+    /* Allow glob assignments like *$x = ..., which, when the glob has a
+       SVf_FAKE flag, cannot be distinguished from $x = ... without looking
+       at the op tree. */
+    if( SvTYPE(right) == SVt_PVGV && cBINOP->op_last->op_type == OP_RV2GV
+     && (wasfake = SvFLAGS(right) & SVf_FAKE) )
+       SvFLAGS(right) &= ~SVf_FAKE;
     SvSetMagicSV(right, left);
+    if(wasfake) SvFLAGS(right) |= SVf_FAKE;
     SETs(right);
     RETURN;
 }
@@ -310,6 +318,7 @@ PP(pp_padsv)
 PP(pp_readline)
 {
     dVAR;
+    dSP; SvGETMAGIC(TOPs);
     tryAMAGICunTARGET(iter, 0);
     PL_last_in_gv = MUTABLE_GV(*PL_stack_sp--);
     if (!isGV_with_GP(PL_last_in_gv)) {
@@ -1052,6 +1061,7 @@ PP(pp_aassign)
            break;
        case SVt_PVHV: {                                /* normal hash */
                SV *tmpstr;
+               SV** topelem = relem;
 
                hash = MUTABLE_HV(sv);
                magic = SvMAGICAL(hash) != 0;
@@ -1065,10 +1075,19 @@ PP(pp_aassign)
                    tmpstr = newSV(0);
                    if (*relem)
                        sv_setsv(tmpstr,*relem);        /* value */
-                   *(relem++) = tmpstr;
-                   if (gimme != G_VOID && hv_exists_ent(hash, sv, 0))
-                       /* key overwrites an existing entry */
-                       duplicates += 2;
+                   relem++;
+                   if (gimme != G_VOID) {
+                       if (hv_exists_ent(hash, sv, 0))
+                           /* key overwrites an existing entry */
+                           duplicates += 2;
+                       else
+                       if (gimme == G_ARRAY) {
+                           /* copy element back: possibly to an earlier
+                            * stack location if we encountered dups earlier */
+                           *topelem++ = sv;
+                           *topelem++ = tmpstr;
+                       }
+                   }
                    didstore = hv_store_ent(hash,sv,tmpstr,0);
                    if (magic) {
                        if (SvSMAGICAL(tmpstr))
@@ -1181,11 +1200,20 @@ PP(pp_aassign)
            SP = lastrelem;
        else if (hash) {
            if (duplicates) {
-               /* Removes from the stack the entries which ended up as
-                * duplicated keys in the hash (fix for [perl #24380]) */
-               Move(firsthashrelem + duplicates,
-                       firsthashrelem, duplicates, SV**);
+               /* at this point we have removed the duplicate key/value
+                * pairs from the stack, but the remaining values may be
+                * wrong; i.e. with (a 1 a 2 b 3) on the stack we've removed
+                * the (a 2), but the stack now probably contains
+                * (a <freed> b 3), because { hv_save(a,1); hv_save(a,2) }
+                * obliterates the earlier key. So refresh all values. */
                lastrelem -= duplicates;
+               relem = firsthashrelem;
+               while (relem < lastrelem) {
+                   HE *he;
+                   sv = *relem++;
+                   he = hv_fetch_ent(hash, sv, 0, 0);
+                   *relem++ = (he ? HeVAL(he) : &PL_sv_undef);
+               }
            }
            SP = lastrelem;
        }
@@ -1218,7 +1246,7 @@ PP(pp_qr)
     SvROK_on(rv);
 
     if (pkg) {
-       HV* const stash = gv_stashpv(SvPV_nolen(pkg), GV_ADD);
+       HV *const stash = gv_stashsv(pkg, GV_ADD);
        SvREFCNT_dec(pkg);
        (void)sv_bless(rv, stash);
     }
@@ -1326,9 +1354,9 @@ PP(pp_match)
        /g matches against large strings.  So far a solution to this problem
        appears to be quite tricky.
        Test for the unsafe vars are TODO for now. */
-    if ((  !global && RX_NPARENS(rx)) 
-           || SvTEMP(TARG) || PL_sawampersand ||
-           (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)))
+    if (       (!global && RX_NPARENS(rx))
+           || SvTEMP(TARG) || SvAMAGIC(TARG) || PL_sawampersand
+           || (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)))
        r_flags |= REXEC_COPY_STR;
     if (SvSCREAM(TARG))
        r_flags |= REXEC_SCREAM;
@@ -1639,8 +1667,12 @@ Perl_do_readline(pTHX)
        }
        SvUPGRADE(sv, SVt_PV);
        tmplen = SvLEN(sv);     /* remember if already alloced */
-       if (!tmplen && !SvREADONLY(sv))
-           Sv_Grow(sv, 80);    /* try short-buffering it */
+       if (!tmplen && !SvREADONLY(sv)) {
+            /* try short-buffering it. Please update t/op/readline.t
+            * if you change the growth length.
+            */
+           Sv_Grow(sv, 80);
+        }
        offset = 0;
        if (type == OP_RCATLINE && SvOK(sv)) {
            if (!SvPOK(sv)) {
@@ -2597,10 +2629,13 @@ PP(pp_leavesublv)
            MARK = newsp + 1;
            EXTEND_MORTAL(1);
            if (MARK == SP) {
-               /* Temporaries are bad unless they happen to be elements
-                * of a tied hash or array */
-               if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY) &&
-                   !(SvRMAGICAL(TOPs) && mg_find(TOPs, PERL_MAGIC_tiedelem))) {
+               /* Temporaries are bad unless they happen to have set magic
+                * attached, such as the elements of a tied hash or array */
+               if ((SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP) ||
+                    (SvFLAGS(TOPs) & (SVf_READONLY | SVf_FAKE))
+                      == SVf_READONLY
+                   ) &&
+                   !SvSMAGICAL(TOPs)) {
                    LEAVE;
                    cxstack_ix--;
                    POPSUB(cx,sv);
@@ -2909,7 +2944,7 @@ try_autoload:
 
        /* CvXSUB(cv) must not be NULL because newXS() refuses NULL xsub address */
        assert(CvXSUB(cv));
-       CALL_FPTR(CvXSUB(cv))(aTHX_ cv);
+       CvXSUB(cv)(aTHX_ cv);
 
        /* Enforce some sanity in scalar context. */
        if (gimme == G_SCALAR && ++markix != PL_stack_sp - PL_stack_base ) {