Corrected Perl5 example of Formatted output and significant digits

[perl5.git] / pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index daaed7a..34542c2 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -123,7 +123,7 @@ PP(pp_sassign)
     if (PL_op->op_private & OPpASSIGN_CV_TO_GV) {
        SV * const cv = SvRV(left);
        const U32 cv_type = SvTYPE(cv);
-       const U32 gv_type = SvTYPE(right);
+       const bool is_gv = isGV_with_GP(right);
        const bool got_coderef = cv_type == SVt_PVCV || cv_type == SVt_PVFM;
 
        if (!got_coderef) {
@@ -133,7 +133,7 @@ PP(pp_sassign)
        /* Can do the optimisation if right (LVALUE) is not a typeglob,
           left (RVALUE) is a reference to something, and we're in void
           context. */
-       if (!got_coderef && gv_type != SVt_PVGV && GIMME_V == G_VOID) {
+       if (!got_coderef && !is_gv && GIMME_V == G_VOID) {
            /* Is the target symbol table currently empty?  */
            GV * const gv = gv_fetchsv(right, GV_NOINIT, SVt_PVGV);
            if (SvTYPE(gv) != SVt_PVGV && !SvOK(gv)) {
@@ -151,7 +151,7 @@ PP(pp_sassign)
        }
 
        /* Need to fix things up.  */
-       if (gv_type != SVt_PVGV) {
+       if (!is_gv) {
            /* Need to fix GV.  */
            right = MUTABLE_SV(gv_fetchsv(right, GV_ADD, SVt_PVGV));
        }
@@ -201,7 +201,7 @@ 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
+    if( isGV_with_GP(right) && cBINOP->op_last->op_type == OP_RV2GV
      && (wasfake = SvFLAGS(right) & SVf_FAKE) )
        SvFLAGS(right) &= ~SVf_FAKE;
     SvSetMagicSV(right, left);
@@ -751,7 +751,7 @@ PP(pp_print)
        RETURN;
     }
     if (!(io = GvIO(gv))) {
-        if ((GvEGVx(gv)) && (io = GvIO(GvEGV(gv)))
+        if ( gv && GvEGVx(gv) && (io = GvIO(GvEGV(gv)))
            && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar)))
             goto had_magic;
        if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
@@ -1061,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;
@@ -1074,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))
@@ -1190,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;
        }
@@ -2442,6 +2461,7 @@ PP(pp_grepwhile)
     if (SvTRUEx(POPs))
        PL_stack_base[PL_markstack_ptr[-1]++] = PL_stack_base[*PL_markstack_ptr];
     ++*PL_markstack_ptr;
+    FREETMPS;
     LEAVE_with_name("grep_item");                                      /* exit inner scope */
 
     /* All done yet? */
@@ -2730,6 +2750,7 @@ PP(pp_entersub)
     case SVt_PVGV:
        if (!isGV_with_GP(sv))
            DIE(aTHX_ "Not a CODE reference");
+      we_have_a_glob:
        if (!(cv = GvCVu((const GV *)sv))) {
            HV *stash;
            cv = sv_2cv(sv, &stash, &gv, 0);
@@ -2740,6 +2761,9 @@ PP(pp_entersub)
            goto try_autoload;
        }
        break;
+    case SVt_PVLV:
+       if(isGV_with_GP(sv)) goto we_have_a_glob;
+       /*FALLTHROUGH*/
     default:
        if (sv == &PL_sv_yes) {         /* unfound import, ignore */
            if (hasargs)