Re: [ID 20000816.012] *foo = *_ is broken

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index 029d0fa..065a292 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1032,7 +1032,7 @@ static const struct body_details bodies_by_type[] = {
 #define new_NOARENAZ(details) \
        my_safecalloc((details)->body_size + (details)->offset)
 
-#ifdef DEBUGGING
+#if defined(DEBUGGING) && !defined(PERL_GLOBAL_STRUCT_PRIVATE)
 static bool done_sanity_check;
 #endif
 
@@ -1048,7 +1048,9 @@ S_more_bodies (pTHX_ svtype sv_type)
 
     assert(bdp->arena_size);
 
-#ifdef DEBUGGING
+#if defined(DEBUGGING) && !defined(PERL_GLOBAL_STRUCT_PRIVATE)
+    /* PERL_GLOBAL_STRUCT_PRIVATE cannot coexist with global
+     * variables like done_sanity_check. */
     if (!done_sanity_check) {
        unsigned int i = SVt_LAST;
 
@@ -1120,12 +1122,12 @@ You generally want to use the C<SvUPGRADE> macro wrapper. See also C<svtype>.
 */
 
 void
-Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type)
+Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
 {
     dVAR;
     void*      old_body;
     void*      new_body;
-    const U32  old_type = SvTYPE(sv);
+    const svtype old_type = SvTYPE(sv);
     const struct body_details *new_type_details;
     const struct body_details *const old_type_details
        = bodies_by_type + old_type;
@@ -1496,6 +1498,7 @@ Perl_sv_setiv(pTHX_ register SV *sv, IV i)
     case SVt_PVIO:
        Perl_croak(aTHX_ "Can't coerce %s to integer in %s", sv_reftype(sv,0),
                   OP_DESC(PL_op));
+    default: NOOP;
     }
     (void)SvIOK_only(sv);                      /* validate number */
     SvIV_set(sv, i);
@@ -1596,6 +1599,7 @@ Perl_sv_setnv(pTHX_ register SV *sv, NV num)
     case SVt_PVIO:
        Perl_croak(aTHX_ "Can't coerce %s to number in %s", sv_reftype(sv,0),
                   OP_NAME(PL_op));
+    default: NOOP;
     }
     SvNV_set(sv, num);
     (void)SvNOK_only(sv);                      /* validate number */
@@ -2796,7 +2800,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
        /* some Xenix systems wipe out errno here */
 #ifdef apollo
        if (SvNVX(sv) == 0.0)
-           (void)strcpy(s,"0");
+           my_strlcpy(s, "0", SvLEN(sv));
        else
 #endif /*apollo*/
        {
@@ -2805,7 +2809,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
        errno = olderrno;
 #ifdef FIXNEGATIVEZERO
         if (*s == '-' && s[1] == '0' && !s[2])
-           strcpy(s,"0");
+           my_strlcpy(s, "0", SvLEN(s));
 #endif
        while (*s) s++;
 #ifdef hcx
@@ -3348,7 +3352,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
     dVAR;
     register U32 sflags;
     register int dtype;
-    register int stype;
+    register svtype stype;
 
     if (sstr == dstr)
        return;
@@ -3483,7 +3487,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
        if (stype == SVt_PVLV)
            SvUPGRADE(dstr, SVt_PVNV);
        else
-           SvUPGRADE(dstr, (U32)stype);
+           SvUPGRADE(dstr, (svtype)stype);
     }
 
     /* dstr may have been upgraded.  */
@@ -3933,8 +3937,10 @@ Perl_sv_usepvn_flags(pTHX_ SV *sv, char *ptr, STRLEN len, U32 flags)
     if (SvPVX_const(sv))
        SvPV_free(sv);
 
+#ifdef DEBUGGING
     if (flags & SV_HAS_TRAILING_NUL)
        assert(ptr[len] == '\0');
+#endif
 
     allocate = (flags & SV_HAS_TRAILING_NUL)
        ? len + 1: PERL_STRLEN_ROUNDUP(len + 1);
@@ -4642,7 +4648,8 @@ Perl_sv_unmagic(pTHX_ SV *sv, int type)
 Weaken a reference: set the C<SvWEAKREF> flag on this RV; give the
 referred-to SV C<PERL_MAGIC_backref> magic if it hasn't already; and
 push a back-reference to this RV onto the array of backreferences
-associated with that magic.
+associated with that magic. If the RV is magical, set magic will be
+called after the RV is cleared.
 
 =cut
 */
@@ -4795,6 +4802,7 @@ Perl_sv_kill_backrefs(pTHX_ SV *sv, AV *av)
                    SvRV_set(referrer, 0);
                    SvOK_off(referrer);
                    SvWEAKREF_off(referrer);
+                   SvSETMAGIC(referrer);
                } else if (SvTYPE(referrer) == SVt_PVGV ||
                           SvTYPE(referrer) == SVt_PVLV) {
                    /* You lookin' at me?  */
@@ -9015,18 +9023,19 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
        integer:
            {
                char *ptr = ebuf + sizeof ebuf;
+               bool tempalt = uv ? alt : FALSE; /* Vectors can't change alt */
+               zeros = 0;
+
                switch (base) {
                    unsigned dig;
                case 16:
-                   if (!uv)
-                       alt = FALSE;
                    p = (char*)((c == 'X')
                                ? "0123456789ABCDEF" : "0123456789abcdef");
                    do {
                        dig = uv & 15;
                        *--ptr = p[dig];
                    } while (uv >>= 4);
-                   if (alt) {
+                   if (tempalt) {
                        esignbuf[esignlen++] = '0';
                        esignbuf[esignlen++] = c;  /* 'x' or 'X' */
                    }
@@ -9040,13 +9049,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                        *--ptr = '0';
                    break;
                case 2:
-                   if (!uv)
-                       alt = FALSE;
                    do {
                        dig = uv & 1;
                        *--ptr = '0' + dig;
                    } while (uv >>= 1);
-                   if (alt) {
+                   if (tempalt) {
                        esignbuf[esignlen++] = '0';
                        esignbuf[esignlen++] = 'b';
                    }