This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
move POPBLOCK after arg stack munging
[perl5.git] / sv.c
diff --git a/sv.c b/sv.c
index 53133b9..87c48ac 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -4184,9 +4184,18 @@ Perl_gv_setref(pTHX_ SV *const dstr, SV *const sstr)
            }
            else
            {
+                SSize_t i;
                sv_magic(
                 sref, omg ? omg->mg_obj : dstr, PERL_MAGIC_isa, NULL, 0
                );
+                for (i = 0; i <= AvFILL(sref); ++i) {
+                    SV **elem = av_fetch ((AV*)sref, i, 0);
+                    if (elem) {
+                        sv_magic(
+                          *elem, sref, PERL_MAGIC_isaelem, NULL, i
+                        );
+                    }
+                }
                mg = mg_find(sref, PERL_MAGIC_isa);
            }
            /* Since the *ISA assignment could have affected more than
@@ -5757,10 +5766,9 @@ S_sv_unmagicext_flags(pTHX_ SV *const sv, const int type, MGVTBL *vtbl, const U3
        if (SvMAGICAL(sv))      /* if we're under save_magic, wait for restore_magic; */
            mg_magical(sv);     /*    else fix the flags now */
     }
-    else {
+    else
        SvMAGICAL_off(sv);
-       SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
-    }
+
     return 0;
 }
 
@@ -12332,6 +12340,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                 U8* v = vhex; /* working pointer to vhex */
                 U8* vend; /* pointer to one beyond last digit of vhex */
                 U8* vfnz = NULL; /* first non-zero */
+                U8* vlnz = NULL; /* last non-zero */
                 const bool lower = (c == 'a');
                 /* At output the values of vhex (up to vend) will
                  * be mapped through the xdig to get the actual
@@ -12339,6 +12348,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                 const char* xdig = PL_hexdigit;
                 int zerotail = 0; /* how many extra zeros to append */
                 int exponent = 0; /* exponent of the floating point input */
+                bool hexradix = FALSE; /* should we output the radix */
 
                 /* XXX: denormals, NaN, Inf.
                  *
@@ -12364,7 +12374,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
 #endif
 
                 if (fv < 0
-                    || Perl_signbit(fv)
+                    || Perl_signbit(nv)
                   )
                     *p++ = '-';
                 else if (plus)
@@ -12387,8 +12397,6 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                 }
 
                 if (vfnz) {
-                    U8* vlnz = NULL; /* The last non-zero. */
-
                     /* Find the last non-zero xdigit. */
                     for (v = vend - 1; v >= vhex; v--) {
                         if (*v) {
@@ -12448,9 +12456,24 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                     v = vhex;
                     *p++ = xdig[*v++];
 
-                    /* The radix is always output after the first
-                     * non-zero xdigit, or if alt.  */
-                    if (vfnz < vlnz || alt) {
+                    /* If there are non-zero xdigits, the radix
+                     * is output after the first one. */
+                    if (vfnz < vlnz) {
+                      hexradix = TRUE;
+                    }
+                }
+                else {
+                    *p++ = '0';
+                    exponent = 0;
+                    zerotail = precis;
+                }
+
+                /* The radix is always output if precis, or if alt. */
+                if (precis > 0 || alt) {
+                  hexradix = TRUE;
+                }
+
+                if (hexradix) {
 #ifndef USE_LOCALE_NUMERIC
                         *p++ = '.';
 #else
@@ -12466,17 +12489,17 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                         }
                         RESTORE_LC_NUMERIC();
 #endif
-                    }
+                }
 
+                if (vlnz) {
                     while (v <= vlnz)
                         *p++ = xdig[*v++];
-
-                    while (zerotail--)
-                        *p++ = '0';
                 }
-                else {
+
+                if (zerotail > 0) {
+                  while (zerotail--) {
                     *p++ = '0';
-                    exponent = 0;
+                  }
                 }
 
                 elen = p - PL_efloatbuf;
@@ -13919,18 +13942,14 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
            ncx->blk_oldcop = (COP*)any_dup(ncx->blk_oldcop, param->proto_perl);
            switch (CxTYPE(ncx)) {
            case CXt_SUB:
-               ncx->blk_sub.cv         = (ncx->blk_sub.olddepth == 0
-                                          ? cv_dup_inc(ncx->blk_sub.cv, param)
-                                          : cv_dup(ncx->blk_sub.cv,param));
+               ncx->blk_sub.cv         = cv_dup_inc(ncx->blk_sub.cv, param);
                if(CxHASARGS(ncx)){
-                   ncx->blk_sub.argarray = av_dup_inc(ncx->blk_sub.argarray,param);
                    ncx->blk_sub.savearray = av_dup_inc(ncx->blk_sub.savearray,param);
                } else {
-                   ncx->blk_sub.argarray = NULL;
                    ncx->blk_sub.savearray = NULL;
                }
-               ncx->blk_sub.oldcomppad = (PAD*)ptr_table_fetch(PL_ptr_table,
-                                          ncx->blk_sub.oldcomppad);
+               ncx->blk_sub.prevcomppad = (PAD*)ptr_table_fetch(PL_ptr_table,
+                                          ncx->blk_sub.prevcomppad);
                break;
            case CXt_EVAL:
                ncx->blk_eval.old_namesv = sv_dup_inc(ncx->blk_eval.old_namesv,
@@ -13958,10 +13977,16 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
            case CXt_LOOP_PLAIN:
                 /* code common to all CXt_LOOP_* types */
                if (CxPADLOOP(ncx)) {
-                   ncx->blk_loop.itervar_u.oldcomppad
-                       = (PAD*)ptr_table_fetch(PL_ptr_table,
-                                       ncx->blk_loop.itervar_u.oldcomppad);
-               } else {
+                    PADOFFSET off = ncx->blk_loop.itervar_u.svp
+                                    - &CX_CURPAD_SV(ncx->blk_loop, 0);
+                    ncx->blk_loop.oldcomppad =
+                                    (PAD*)ptr_table_fetch(PL_ptr_table,
+                                                ncx->blk_loop.oldcomppad);
+                   ncx->blk_loop.itervar_u.svp =
+                                    &CX_CURPAD_SV(ncx->blk_loop, off);
+
+                }
+               else {
                    ncx->blk_loop.itervar_u.gv
                        = gv_dup((const GV *)ncx->blk_loop.itervar_u.gv,
                                    param);
@@ -15318,7 +15343,7 @@ will be converted into Unicode (and UTF-8).
 If C<sv> already is UTF-8 (or if it is not C<POK>), or if C<encoding>
 is not a reference, nothing is done to C<sv>.  If C<encoding> is not
 an C<Encode::XS> Encoding object, bad things will happen.
-(See F<lib/encoding.pm> and L<Encode>.)
+(See F<cpan/Encode/encoding.pm> and L<Encode>.)
 
 The PV of C<sv> is returned.