[asperl] fixups to make it build and pass tests under both compilers

[p5sagit/p5-mst-13.2.git] / sv.c

diff --git a/sv.c b/sv.c
index 9de4333..f5a979a 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -919,10 +919,10 @@ sv_upgrade(register SV *sv, U32 mt)
     return TRUE;
 }
 
-#ifdef DEBUGGING
 char *
 sv_peek(SV *sv)
 {
+#ifdef DEBUGGING
     SV *t = sv_newmortal();
     STRLEN prevlen;
     int unref = 0;
@@ -1064,8 +1064,10 @@ sv_peek(SV *sv)
            sv_catpv(t, ")");
     }
     return SvPV(t, na);
+#else  /* DEBUGGING */
+    return "";
+#endif /* DEBUGGING */
 }
-#endif
 
 int
 sv_backoff(register SV *sv)
@@ -1709,7 +1711,7 @@ sv_2pv(register SV *sv, STRLEN *lp)
                case SVt_PVHV:  s = "HASH";                     break;
                case SVt_PVCV:  s = "CODE";                     break;
                case SVt_PVGV:  s = "GLOB";                     break;
-               case SVt_PVFM:  s = "FORMLINE";                 break;
+               case SVt_PVFM:  s = "FORMAT";                   break;
                case SVt_PVIO:  s = "IO";                       break;
                default:        s = "UNKNOWN";                  break;
                }
@@ -1912,8 +1914,11 @@ sv_setsv(SV *dstr, register SV *sstr)
 
     switch (stype) {
     case SVt_NULL:
-       (void)SvOK_off(dstr);
-       return;
+       if (dtype != SVt_PVGV) {
+           (void)SvOK_off(dstr);
+           return;
+       }
+       break;
     case SVt_IV:
        if (dtype != SVt_IV && dtype < SVt_PVIV) {
            if (dtype < SVt_IV)
@@ -2074,6 +2079,12 @@ sv_setsv(SV *dstr, register SV *sstr)
                            if (!GvCVGEN((GV*)dstr) &&
                                (CvROOT(cv) || CvXSUB(cv)))
                            {
+                               SV *const_sv = cv_const_sv(cv);
+                               bool const_changed = TRUE; 
+                               if(const_sv)
+                                   const_changed = sv_cmp(const_sv, 
+                                          op_const_sv(CvSTART((CV*)sref), 
+                                                      Nullcv));
                                /* ahem, death to those who redefine
                                 * active sort subs */
                                if (curstackinfo->si_type == SI_SORT &&
@@ -2081,15 +2092,14 @@ sv_setsv(SV *dstr, register SV *sstr)
                                    croak(
                                    "Can't redefine active sort subroutine %s",
                                          GvENAME((GV*)dstr));
-                               if (cv_const_sv(cv))
-                                   warn("Constant subroutine %s redefined",
-                                        GvENAME((GV*)dstr));
-                               else if (dowarn) {
+                               if (dowarn || (const_changed && const_sv)) {
                                    if (!(CvGV(cv) && GvSTASH(CvGV(cv))
                                          && HvNAME(GvSTASH(CvGV(cv)))
                                          && strEQ(HvNAME(GvSTASH(CvGV(cv))),
                                                   "autouse")))
-                                       warn("Subroutine %s redefined",
+                                       warn(const_sv ? 
+                                            "Constant subroutine %s redefined"
+                                            : "Subroutine %s redefined", 
                                             GvENAME((GV*)dstr));
                                }
                            }
@@ -2215,7 +2225,12 @@ sv_setsv(SV *dstr, register SV *sstr)
        SvIVX(dstr) = SvIVX(sstr);
     }
     else {
-       (void)SvOK_off(dstr);
+       if (dtype == SVt_PVGV) {
+           if (dowarn)
+               warn("Undefined value assigned to typeglob");
+       }
+       else
+           (void)SvOK_off(dstr);
     }
     SvTAINT(dstr);
 }
@@ -2427,11 +2442,7 @@ sv_catpv_mg(register SV *sv, register char *ptr)
 }
 
 SV *
-#ifdef LEAKTEST
-newSV(I32 x, STRLEN len)
-#else
 newSV(STRLEN len)
-#endif
 {
     register SV *sv;
     
@@ -2640,10 +2651,17 @@ sv_insert(SV *bigstr, STRLEN offset, STRLEN len, char *little, STRLEN littlelen)
     register char *midend;
     register char *bigend;
     register I32 i;
+    STRLEN curlen;
+    
 
     if (!bigstr)
        croak("Can't modify non-existent substring");
-    SvPV_force(bigstr, na);
+    SvPV_force(bigstr, curlen);
+    if (offset + len > curlen) {
+       SvGROW(bigstr, offset+len+1);
+       Zero(SvPVX(bigstr)+curlen, offset+len-curlen, char);
+       SvCUR_set(bigstr, offset+len);
+    }
 
     i = littlelen - len;
     if (i > 0) {                       /* string might grow */
@@ -3576,16 +3594,8 @@ newSVpvn(char *s, STRLEN len)
     return sv;
 }
 
-#ifdef I_STDARG
 SV *
 newSVpvf(const char* pat, ...)
-#else
-/*VARARGS0*/
-SV *
-newSVpvf(pat, va_alist)
-const char *pat;
-va_dcl
-#endif
 {
     register SV *sv;
     va_list args;
@@ -3594,11 +3604,7 @@ va_dcl
     SvANY(sv) = 0;
     SvREFCNT(sv) = 1;
     SvFLAGS(sv) = 0;
-#ifdef I_STDARG
     va_start(args, pat);
-#else
-    va_start(args);
-#endif
     sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
     va_end(args);
     return sv;
@@ -3703,7 +3709,7 @@ sv_reset(register char *s, HV *stash)
 
     if (!*s) {         /* reset ?? searches */
        for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) {
-           pm->op_pmflags &= ~PMf_USED;
+           pm->op_pmdynflags &= ~PMdf_USED;
        }
        return;
     }
@@ -3983,7 +3989,7 @@ sv_reftype(SV *sv, int ob)
        case SVt_PVHV:          return "HASH";
        case SVt_PVCV:          return "CODE";
        case SVt_PVGV:          return "GLOB";
-       case SVt_PVFM:          return "FORMLINE";
+       case SVt_PVFM:          return "FORMAT";
        default:                return "UNKNOWN";
        }
     }
@@ -4215,92 +4221,40 @@ sv_setpviv_mg(SV *sv, IV iv)
     SvSETMAGIC(sv);
 }
 
-#ifdef I_STDARG
 void
 sv_setpvf(SV *sv, const char* pat, ...)
-#else
-/*VARARGS0*/
-void
-sv_setpvf(sv, pat, va_alist)
-    SV *sv;
-    const char *pat;
-    va_dcl
-#endif
 {
     va_list args;
-#ifdef I_STDARG
     va_start(args, pat);
-#else
-    va_start(args);
-#endif
     sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
     va_end(args);
 }
 
 
-#ifdef I_STDARG
 void
 sv_setpvf_mg(SV *sv, const char* pat, ...)
-#else
-/*VARARGS0*/
-void
-sv_setpvf_mg(sv, pat, va_alist)
-    SV *sv;
-    const char *pat;
-    va_dcl
-#endif
 {
     va_list args;
-#ifdef I_STDARG
     va_start(args, pat);
-#else
-    va_start(args);
-#endif
     sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
     va_end(args);
     SvSETMAGIC(sv);
 }
 
-#ifdef I_STDARG
 void
 sv_catpvf(SV *sv, const char* pat, ...)
-#else
-/*VARARGS0*/
-void
-sv_catpvf(sv, pat, va_alist)
-    SV *sv;
-    const char *pat;
-    va_dcl
-#endif
 {
     va_list args;
-#ifdef I_STDARG
     va_start(args, pat);
-#else
-    va_start(args);
-#endif
     sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
     va_end(args);
 }
 
-#ifdef I_STDARG
 void
 sv_catpvf_mg(SV *sv, const char* pat, ...)
-#else
-/*VARARGS0*/
-void
-sv_catpvf_mg(sv, pat, va_alist)
-    SV *sv;
-    const char *pat;
-    va_dcl
-#endif
 {
     va_list args;
-#ifdef I_STDARG
     va_start(args, pat);
-#else
-    va_start(args);
-#endif
     sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
     va_end(args);
     SvSETMAGIC(sv);
@@ -4809,10 +4763,10 @@ sv_vcatpvfn(SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs,
     }
 }
 
-#ifdef DEBUGGING
 void
 sv_dump(SV *sv)
 {
+#ifdef DEBUGGING
     SV *d = sv_newmortal();
     char *s;
     U32 flags;
@@ -5076,14 +5030,5 @@ sv_dump(SV *sv)
        PerlIO_printf(Perl_debug_log, "  FLAGS = 0x%lx\n", (long)IoFLAGS(sv));
        break;
     }
+#endif /* DEBUGGING */
 }
-#else
-void
-sv_dump(SV *sv)
-{
-}
-#endif
-
-
-
-