Race condition fix in threads.pm
[p5sagit/p5-mst-13.2.git] / sv.c
diff --git a/sv.c b/sv.c
index 065a292..cd10844 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1092,8 +1092,8 @@ S_more_bodies (pTHX_ svtype sv_type)
     STMT_START { \
        void ** const r3wt = &PL_body_roots[sv_type]; \
        LOCK_SV_MUTEX; \
-       xpv = *((void **)(r3wt)) \
-         ? *((void **)(r3wt)) : more_bodies(sv_type); \
+       xpv = (PTR_TBL_ENT_t*) (*((void **)(r3wt))      \
+         ? *((void **)(r3wt)) : more_bodies(sv_type)); \
        *(r3wt) = *(void**)(xpv); \
        UNLOCK_SV_MUTEX; \
     } STMT_END
@@ -1450,10 +1450,10 @@ Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen)
                return s;
            } else
 #endif
-           s = saferealloc(s, newlen);
+           s = (char*)saferealloc(s, newlen);
        }
        else {
-           s = safemalloc(newlen);
+           s = (char*)safemalloc(newlen);
            if (SvPVX_const(sv) && SvCUR(sv)) {
                Move(SvPVX_const(sv), s, (newlen < SvCUR(sv)) ? newlen : SvCUR(sv), char);
            }
@@ -2688,7 +2688,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                s = SvGROW_mutable(sv, len + 1);
                SvCUR_set(sv, len);
                SvPOKp_on(sv);
-               return memcpy(s, tbuf, len + 1);
+               return (char*)memcpy(s, tbuf, len + 1);
            }
        }
         if (SvROK(sv)) {
@@ -3317,9 +3317,10 @@ S_glob_assign_ref(pTHX_ SV *dstr, SV *sstr) {
                                         || sv_cmp(cv_const_sv(cv),
                                                   cv_const_sv((CV*)sref))))) {
                            Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
-                                       CvCONST(cv)
-                                       ? "Constant subroutine %s::%s redefined"
-                                       : "Subroutine %s::%s redefined",
+                                       (const char *)
+                                       (CvCONST(cv)
+                                        ? "Constant subroutine %s::%s redefined"
+                                        : "Subroutine %s::%s redefined"),
                                        HvNAME_get(GvSTASH((GV*)dstr)),
                                        GvENAME((GV*)dstr));
                        }
@@ -3950,13 +3951,13 @@ Perl_sv_usepvn_flags(pTHX_ SV *sv, char *ptr, STRLEN len, U32 flags)
     } else {
 #ifdef DEBUGGING
        /* Force a move to shake out bugs in callers.  */
-       char *new_ptr = safemalloc(allocate);
+       char *new_ptr = (char*)safemalloc(allocate);
        Copy(ptr, new_ptr, len, char);
        PoisonFree(ptr,len,char);
        Safefree(ptr);
        ptr = new_ptr;
 #else
-       ptr = saferealloc (ptr, allocate);
+       ptr = (char*) saferealloc (ptr, allocate);
 #endif
     }
     SvPV_set(sv, ptr);
@@ -5351,8 +5352,8 @@ Perl_sv_len_utf8(pTHX_ register SV *sv)
                        */
                        SAVEI8(PL_utf8cache);
                        PL_utf8cache = 0;
-                       Perl_croak(aTHX_ "panic: sv_len_utf8 cache %"UVf
-                                  " real %"UVf" for %"SVf,
+                       Perl_croak(aTHX_ "panic: sv_len_utf8 cache %"UVuf
+                                  " real %"UVuf" for %"SVf,
                                   (UV) ulen, (UV) real, (void*)sv);
                    }
                }
@@ -5509,8 +5510,8 @@ S_sv_pos_u2b_cached(pTHX_ SV *sv, MAGIC **mgp, const U8 *const start,
                   infinitely while printing error messages.  */
                SAVEI8(PL_utf8cache);
                PL_utf8cache = 0;
-               Perl_croak(aTHX_ "panic: sv_pos_u2b_cache cache %"UVf
-                          " real %"UVf" for %"SVf,
+               Perl_croak(aTHX_ "panic: sv_pos_u2b_cache cache %"UVuf
+                          " real %"UVuf" for %"SVf,
                           (UV) boffset, (UV) real_boffset, (void*)sv);
            }
        }
@@ -5643,8 +5644,8 @@ S_utf8_mg_pos_cache_update(pTHX_ SV *sv, MAGIC **mgp, STRLEN byte, STRLEN utf8,
               infinitely while printing error messages.  */
            SAVEI8(PL_utf8cache);
            PL_utf8cache = 0;
-           Perl_croak(aTHX_ "panic: utf8_mg_pos_cache_update cache %"UVf
-                      " real %"UVf" for %"SVf, (UV) utf8, (UV) realutf8, (void*)sv);
+           Perl_croak(aTHX_ "panic: utf8_mg_pos_cache_update cache %"UVuf
+                      " real %"UVuf" for %"SVf, (UV) utf8, (UV) realutf8, (void*)sv);
        }
     }
 
@@ -5889,8 +5890,8 @@ Perl_sv_pos_b2u(pTHX_ register SV* sv, I32* offsetp)
                   infinitely while printing error messages.  */
                SAVEI8(PL_utf8cache);
                PL_utf8cache = 0;
-               Perl_croak(aTHX_ "panic: sv_pos_b2u cache %"UVf
-                          " real %"UVf" for %"SVf,
+               Perl_croak(aTHX_ "panic: sv_pos_b2u cache %"UVuf
+                          " real %"UVuf" for %"SVf,
                           (UV) len, (UV) real_len, (void*)sv);
            }
        }
@@ -5927,8 +5928,16 @@ Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
        pv1 = "";
        cur1 = 0;
     }
-    else
+    else {
+       /* if pv1 and pv2 are the same, second SvPV_const call may
+        * invalidate pv1, so we may need to make a copy */
+       if (sv1 == sv2 && (SvTHINKFIRST(sv1) || SvGMAGICAL(sv1))) {
+           pv1 = SvPV_const(sv1, cur1);
+           sv1 = sv_2mortal(newSVpvn(pv1, cur1));
+           if (SvUTF8(sv2)) SvUTF8_on(sv1);
+       }
        pv1 = SvPV_const(sv1, cur1);
+    }
 
     if (!sv2){
        pv2 = "";
@@ -6924,7 +6933,7 @@ Perl_newSVpv(pTHX_ const char *s, STRLEN len)
     register SV *sv;
 
     new_SV(sv);
-    sv_setpvn(sv,s,len ? len : strlen(s));
+    sv_setpvn(sv, s, len || s == NULL ? len : strlen(s));
     return sv;
 }
 
@@ -9499,6 +9508,7 @@ Perl_re_dup(pTHX_ const REGEXP *r, CLONE_PARAMS *param)
     for (s = ret->substrs->data, i = 0; i < 3; i++, s++) {
        s->min_offset = r->substrs->data[i].min_offset;
        s->max_offset = r->substrs->data[i].max_offset;
+       s->end_shift  = r->substrs->data[i].end_shift;
        s->substr     = sv_dup_inc(r->substrs->data[i].substr, param);
        s->utf8_substr = sv_dup_inc(r->substrs->data[i].utf8_substr, param);
     }
@@ -10277,13 +10287,13 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
                ncx->blk_sub.cv         = (cx->blk_sub.olddepth == 0
                                           ? cv_dup_inc(cx->blk_sub.cv, param)
                                           : cv_dup(cx->blk_sub.cv,param));
-               ncx->blk_sub.argarray   = (cx->blk_sub.hasargs
+               ncx->blk_sub.argarray   = (CX_SUB_HASARGS_GET(cx)
                                           ? av_dup_inc(cx->blk_sub.argarray, param)
                                           : NULL);
                ncx->blk_sub.savearray  = av_dup_inc(cx->blk_sub.savearray, param);
                ncx->blk_sub.olddepth   = cx->blk_sub.olddepth;
-               ncx->blk_sub.hasargs    = cx->blk_sub.hasargs;
-               ncx->blk_sub.lval       = cx->blk_sub.lval;
+               CX_SUB_HASARGS_SET(ncx, CX_SUB_HASARGS_GET(cx));
+               CX_SUB_LVAL_SET(ncx, CX_SUB_LVAL(cx));
                ncx->blk_sub.retop      = cx->blk_sub.retop;
                ncx->blk_sub.oldcomppad = (PAD*)ptr_table_fetch(PL_ptr_table,
                                           cx->blk_sub.oldcomppad);
@@ -10318,7 +10328,7 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
                ncx->blk_sub.cv         = cv_dup(cx->blk_sub.cv, param);
                ncx->blk_sub.gv         = gv_dup(cx->blk_sub.gv, param);
                ncx->blk_sub.dfoutgv    = gv_dup_inc(cx->blk_sub.dfoutgv, param);
-               ncx->blk_sub.hasargs    = cx->blk_sub.hasargs;
+               CX_SUB_HASARGS_SET(ncx, CX_SUB_HASARGS_GET(cx));
                ncx->blk_sub.retop      = cx->blk_sub.retop;
                break;
            case CXt_BLOCK:
@@ -10459,7 +10469,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
            break;
         case SAVEt_HV:                         /* hash reference */
         case SAVEt_AV:                         /* array reference */
-           sv = POPPTR(ss,ix);
+           sv = (SV*) POPPTR(ss,ix);
            TOPPTR(nss,ix) = sv_dup_inc(sv, param);
            gv = (GV*)POPPTR(ss,ix);
            TOPPTR(nss,ix) = gv_dup(gv, param);
@@ -10680,13 +10690,14 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
                new_state->re_state_regeol
                    = pv_dup(old_state->re_state_regeol);
                new_state->re_state_regstartp
-                   = any_dup(old_state->re_state_regstartp, proto_perl);
+                   = (I32*) any_dup(old_state->re_state_regstartp, proto_perl);
                new_state->re_state_regendp
-                   = any_dup(old_state->re_state_regendp, proto_perl);
+                   = (I32*) any_dup(old_state->re_state_regendp, proto_perl);
                new_state->re_state_reglastparen
-                   = any_dup(old_state->re_state_reglastparen, proto_perl);
+                   = (U32*) any_dup(old_state->re_state_reglastparen, 
+                             proto_perl);
                new_state->re_state_reglastcloseparen
-                   = any_dup(old_state->re_state_reglastcloseparen,
+                   = (U32*)any_dup(old_state->re_state_reglastcloseparen,
                              proto_perl);
                /* XXX This just has to be broken. The old save_re_context
                   code did SAVEGENERICPV(PL_reg_start_tmp);
@@ -10706,11 +10717,14 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
                    = sv_dup(old_state->re_state_nrs, param);
 #endif
                new_state->re_state_reg_magic
-                   = any_dup(old_state->re_state_reg_magic, proto_perl);
+                   = (MAGIC*) any_dup(old_state->re_state_reg_magic, 
+                              proto_perl);
                new_state->re_state_reg_oldcurpm
-                   = any_dup(old_state->re_state_reg_oldcurpm, proto_perl);
+                   = (PMOP*) any_dup(old_state->re_state_reg_oldcurpm, 
+                             proto_perl);
                new_state->re_state_reg_curpm
-                   = any_dup(old_state->re_state_reg_curpm, proto_perl);
+                   = (PMOP*)  any_dup(old_state->re_state_reg_curpm, 
+                              proto_perl);
                new_state->re_state_reg_oldsaved
                    = pv_dup(old_state->re_state_reg_oldsaved);
                new_state->re_state_reg_poscache
@@ -11391,7 +11405,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_glob_index      = proto_perl->Iglob_index;
     PL_srand_called    = proto_perl->Isrand_called;
-    PL_uudmap['M']     = 0;            /* reinits on demand */
+    PL_uudmap[(U32) 'M']       = 0;    /* reinits on demand */
     PL_bitcount                = NULL; /* reinits on demand */
 
     if (proto_perl->Ipsig_pend) {