Use the right prototype and a glob is fine (from Rafael).

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

diff --git a/sv.c b/sv.c
index 955153a..6ead8bb 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3683,8 +3683,16 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
            goto glob_assign;
        }
        break;
-    case SVt_PV:
     case SVt_PVFM:
+#ifdef PERL_COPY_ON_WRITE
+       if ((SvFLAGS(sstr) & CAN_COW_MASK) == CAN_COW_FLAGS) {
+           if (dtype < SVt_PVIV)
+               sv_upgrade(dstr, SVt_PVIV);
+           break;
+       }
+       /* Fall through */
+#endif
+    case SVt_PV:
        if (dtype < SVt_PV)
            sv_upgrade(dstr, SVt_PV);
        break;
@@ -4006,6 +4014,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
                 /* making another shared SV.  */
                 STRLEN cur = SvCUR(sstr);
                 STRLEN len = SvLEN(sstr);
+               assert (SvTYPE(dstr) >= SVt_PVIV);
                 if (len) {
                     /* SvIsCOW_normal */
                     /* splice us in between source and next-after-source.  */
@@ -4448,11 +4457,11 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
            char *pvx = SvPVX(sv);
            STRLEN len = SvCUR(sv);
             U32 hash   = SvUVX(sv);
+           SvFAKE_off(sv);
+           SvREADONLY_off(sv);
            SvGROW(sv, len + 1);
            Move(pvx,SvPVX(sv),len,char);
            *SvEND(sv) = '\0';
-           SvFAKE_off(sv);
-           SvREADONLY_off(sv);
            unsharepvn(pvx, SvUTF8(sv) ? -(I32)len : len, hash);
        }
        else if (PL_curcop != &PL_compiling)
@@ -6289,7 +6298,8 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
     I32 rspara = 0;
     I32 recsize;
 
-    SV_CHECK_THINKFIRST_COW_DROP(sv);
+    if (SvTHINKFIRST(sv))
+       sv_force_normal_flags(sv, append ? 0 : SV_COW_DROP_PV);
     /* XXX. If you make this PVIV, then copy on write can copy scalars read
        from <>.
        However, perlbench says it's slower, because the existing swipe code
@@ -11017,7 +11027,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_origalen                = proto_perl->Iorigalen;
     PL_pidstatus       = newHV();                      /* XXX flag for cloning? */
     PL_osname          = SAVEPV(proto_perl->Iosname);
-    PL_sh_path         = proto_perl->Ish_path; /* XXX never deallocated */
+    PL_sh_path_compat  = proto_perl->Ish_path_compat; /* XXX never deallocated */
     PL_sighandlerp     = proto_perl->Isighandlerp;
 
 
@@ -11387,6 +11397,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     /* Pluggable optimizer */
     PL_peepp           = proto_perl->Tpeepp;
 
+    PL_stashcache       = newHV();
+
     if (!(flags & CLONEf_KEEP_PTR_TABLE)) {
         ptr_table_free(PL_ptr_table);
         PL_ptr_table = NULL;
@@ -11499,8 +11511,8 @@ bool
 Perl_sv_cat_decode(pTHX_ SV *dsv, SV *encoding,
                   SV *ssv, int *offset, char *tstr, int tlen)
 {
+    bool ret = FALSE;
     if (SvPOK(ssv) && SvPOK(dsv) && SvROK(encoding) && offset) {
-        bool ret = FALSE;
        SV *offsv;
        dSP;
        ENTER;
@@ -11521,8 +11533,9 @@ Perl_sv_cat_decode(pTHX_ SV *dsv, SV *encoding,
        PUTBACK;
        FREETMPS;
        LEAVE;
-       return ret;
     }
-    Perl_croak(aTHX_ "Invalid argument to sv_cat_decode.");
+    else
+        Perl_croak(aTHX_ "Invalid argument to sv_cat_decode");
+    return ret;
 }