perlio.c: (Coverity) eliminate temp ptr that confuses Coverity into thinking there...

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

diff --git a/sv.c b/sv.c
index de8f973..8e90234 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -6964,9 +6964,23 @@ Perl_newSVhek(pTHX_ const HEK *hek)
            return sv;
        }
        /* This will be overwhelminly the most common case.  */
-       return newSVpvn_share(HEK_KEY(hek),
-                             (HEK_UTF8(hek) ? -HEK_LEN(hek) : HEK_LEN(hek)),
-                             HEK_HASH(hek));
+       {
+           /* Inline most of newSVpvn_share(), because share_hek_hek() is far
+              more efficient than sharepvn().  */
+           SV *sv;
+
+           new_SV(sv);
+           sv_upgrade(sv, SVt_PV);
+           SvPV_set(sv, (char *)HEK_KEY(share_hek_hek(hek)));
+           SvCUR_set(sv, HEK_LEN(hek));
+           SvLEN_set(sv, 0);
+           SvREADONLY_on(sv);
+           SvFAKE_on(sv);
+           SvPOK_on(sv);
+           if (HEK_UTF8(hek))
+               SvUTF8_on(sv);
+           return sv;
+       }
     }
 }
 
@@ -6990,6 +7004,8 @@ Perl_newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash)
     dVAR;
     register SV *sv;
     bool is_utf8 = FALSE;
+    const char *const orig_src = src;
+
     if (len < 0) {
        STRLEN tmplen = -len;
         is_utf8 = TRUE;
@@ -7009,6 +7025,8 @@ Perl_newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash)
     SvPOK_on(sv);
     if (is_utf8)
         SvUTF8_on(sv);
+    if (src != orig_src)
+       Safefree(src);
     return sv;
 }
 
@@ -10560,7 +10578,12 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
            i = POPINT(ss,ix);
            TOPINT(nss,ix) = i;
            ptr = POPPTR(ss,ix);
-           TOPPTR(nss,ix) = Perl_refcounted_he_dup(aTHX_ ptr, param);
+           if (ptr) {
+               HINTS_REFCNT_LOCK;
+               ((struct refcounted_he *)ptr)->refcounted_he_refcnt++;
+               HINTS_REFCNT_UNLOCK;
+           }
+           TOPPTR(nss,ix) = ptr;
            if (i & HINT_LOCALIZE_HH) {
                hv = (HV*)POPPTR(ss,ix);
                TOPPTR(nss,ix) = hv_dup_inc(hv, param);
@@ -10608,8 +10631,6 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
                    = pv_dup(old_state->re_state_bostr);
                new_state->re_state_reginput
                    = pv_dup(old_state->re_state_reginput);
-               new_state->re_state_regbol
-                   = pv_dup(old_state->re_state_regbol);
                new_state->re_state_regeol
                    = pv_dup(old_state->re_state_regeol);
                new_state->re_state_regstartp
@@ -10621,8 +10642,6 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
                new_state->re_state_reglastcloseparen
                    = any_dup(old_state->re_state_reglastcloseparen,
                              proto_perl);
-               new_state->re_state_regtill
-                   = pv_dup(old_state->re_state_regtill);
                /* XXX This just has to be broken. The old save_re_context
                   code did SAVEGENERICPV(PL_reg_start_tmp);
                   PL_reg_start_tmp is char **.
@@ -10636,14 +10655,6 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
                /* I assume that it only ever "worked" because no-one called
                   (pseudo)fork while the regexp engine had re-entered itself.
                */
-               new_state->re_state_reg_call_cc
-                   = any_dup(old_state->re_state_reg_call_cc, proto_perl);
-               new_state->re_state_reg_re
-                   = any_dup(old_state->re_state_reg_re, proto_perl);
-               new_state->re_state_reg_ganch
-                   = pv_dup(old_state->re_state_reg_ganch);
-               new_state->re_state_reg_sv
-                   = sv_dup(old_state->re_state_reg_sv, param);
 #ifdef PERL_OLD_COPY_ON_WRITE
                new_state->re_state_nrs
                    = sv_dup(old_state->re_state_nrs, param);
@@ -10664,6 +10675,22 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
 #endif
                break;
            }
+       case SAVEt_COP_WARNINGS:
+           {
+               void *optr = POPPTR(ss,ix);
+               TOPPTR(nss,ix) = ptr = any_dup(optr, proto_perl);
+               if (ptr != optr) {
+                   /* We duped something in the interpreter structure.  */
+                   ptr = POPPTR(ss,ix);
+                   TOPPTR(nss,ix) = DUP_WARNINGS((STRLEN*)ptr);
+               } else {
+                   /* I don't think that this happens, but it would mean that
+                      we (didn't) dup something shared.  */
+                   ptr = POPPTR(ss,ix);
+                   TOPPTR(nss,ix) = ptr;
+               }
+           }
+           break;
        default:
            Perl_croak(aTHX_ "panic: ss_dup inconsistency (%"IVdf")", (IV) i);
        }
@@ -10917,12 +10944,14 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     ptr_table_store(PL_ptr_table, proto_perl->Icompiling.cop_file, PL_compiling.cop_file);
 
     ptr_table_store(PL_ptr_table, &proto_perl->Icompiling, &PL_compiling);
-    if (!specialWARN(PL_compiling.cop_warnings))
-       PL_compiling.cop_warnings = sv_dup_inc(PL_compiling.cop_warnings, param);
+    PL_compiling.cop_warnings = DUP_WARNINGS(PL_compiling.cop_warnings);
     if (!specialCopIO(PL_compiling.cop_io))
        PL_compiling.cop_io = sv_dup_inc(PL_compiling.cop_io, param);
-    PL_compiling.cop_hints
-       = Perl_refcounted_he_dup(aTHX_ PL_compiling.cop_hints, param);
+    if (PL_compiling.cop_hints) {
+       HINTS_REFCNT_LOCK;
+       PL_compiling.cop_hints->refcounted_he_refcnt++;
+       HINTS_REFCNT_UNLOCK;
+    }
     PL_curcop          = (COP*)any_dup(proto_perl->Tcurcop, proto_perl);
 
     /* pseudo environmental stuff */