[perl #36514] Add curl support to CPAN.pm
[p5sagit/p5-mst-13.2.git] / sv.c
diff --git a/sv.c b/sv.c
index d92d82a..04c6845 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -230,7 +230,7 @@ S_more_sv(pTHX)
     }
     else {
        char *chunk;                /* must use New here to match call to */
-       New(704,chunk,PERL_ARENA_SIZE,char);   /* Safefree() in sv_free_arenas()     */
+       Newx(chunk,PERL_ARENA_SIZE,char);   /* Safefree() in sv_free_arenas()     */
        sv_add_arena(chunk, PERL_ARENA_SIZE, 0);
     }
     uproot_SV(sv);
@@ -1087,7 +1087,7 @@ S_more_bodies (pTHX_ void **arena_root, void **root, size_t size)
     char *start;
     const char *end;
     const size_t count = PERL_ARENA_SIZE/size;
-    New(0, start, count*size, char);
+    Newx(start, count*size, char);
     *((void **) start) = *arena_root;
     *arena_root = (void *)start;
 
@@ -1112,18 +1112,7 @@ S_more_bodies (pTHX_ void **arena_root, void **root, size_t size)
 
 /* grab a new thing from the free list, allocating more if necessary */
 
-STATIC void *
-S_new_body(pTHX_ void **arena_root, void **root, size_t size)
-{
-    void *xpv;
-    LOCK_SV_MUTEX;
-    xpv = *root ? *root : S_more_bodies(aTHX_ arena_root, root, size);
-    *root = *(void**)xpv;
-    UNLOCK_SV_MUTEX;
-    return xpv;
-}
-
-/* and an inline version  */
+/* 1st, the inline version  */
 
 #define new_body_inline(xpv, arena_root, root, size) \
     STMT_START { \
@@ -1134,6 +1123,16 @@ S_new_body(pTHX_ void **arena_root, void **root, size_t size)
        UNLOCK_SV_MUTEX; \
     } STMT_END
 
+/* now use the inline version in the proper function */
+
+STATIC void *
+S_new_body(pTHX_ void **arena_root, void **root, size_t size)
+{
+    void *xpv;
+    new_body_inline(xpv, arena_root, root, size);
+    return xpv;
+}
+
 /* return a thing to the free list */
 
 #define del_body(thing, root)                  \
@@ -2114,7 +2113,7 @@ Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
            return asIV(sv);
        if (!SvROK(sv)) {
            if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-               if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
+               if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
                    report_uninit(sv);
            }
            return 0;
@@ -2374,7 +2373,7 @@ Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
 #endif /* NV_PRESERVES_UV */
        }
     } else  {
-       if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+       if (!PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP) && ckWARN(WARN_UNINITIALIZED))
            report_uninit(sv);
        if (SvTYPE(sv) < SVt_IV)
            /* Typically the caller expects that sv_any is not NULL now.  */
@@ -2422,7 +2421,7 @@ Perl_sv_2uv_flags(pTHX_ register SV *sv, I32 flags)
            return asUV(sv);
        if (!SvROK(sv)) {
            if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-               if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
+               if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
                    report_uninit(sv);
            }
            return 0;
@@ -2663,7 +2662,7 @@ Perl_sv_2uv_flags(pTHX_ register SV *sv, I32 flags)
     }
     else  {
        if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-           if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
+           if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
                report_uninit(sv);
        }
        if (SvTYPE(sv) < SVt_IV)
@@ -2697,7 +2696,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
        if (SvNOKp(sv))
            return SvNVX(sv);
        if (SvPOKp(sv) && SvLEN(sv)) {
-           if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) &&
+           if (!SvIOKp(sv) && ckWARN(WARN_NUMERIC) &&
                !grok_number(SvPVX_const(sv), SvCUR(sv), NULL))
                not_a_number(sv);
            return Atof(SvPVX_const(sv));
@@ -2710,7 +2709,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
        }       
         if (!SvROK(sv)) {
            if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-               if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
+               if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
                    report_uninit(sv);
            }
             return (NV)0;
@@ -2777,7 +2776,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
     else if (SvPOKp(sv) && SvLEN(sv)) {
        UV value;
        const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value);
-       if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !numtype)
+       if (!SvIOKp(sv) && !numtype && ckWARN(WARN_NUMERIC))
            not_a_number(sv);
 #ifdef NV_PRESERVES_UV
        if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
@@ -2859,7 +2858,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 #endif /* NV_PRESERVES_UV */
     }
     else  {
-       if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+       if (!PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP) && ckWARN(WARN_UNINITIALIZED))
            report_uninit(sv);
        if (SvTYPE(sv) < SVt_NV)
            /* Typically the caller expects that sv_any is not NULL now.  */
@@ -3044,7 +3043,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
        }
         if (!SvROK(sv)) {
            if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-               if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
+               if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
                    report_uninit(sv);
            }
            if (lp)
@@ -3152,7 +3151,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                                 }
                             }
 
-                           New(616, mg->mg_ptr, mg->mg_len + 1 + left, char);
+                           Newx(mg->mg_ptr, mg->mg_len + 1 + left, char);
                            Copy("(?", mg->mg_ptr, 2, char);
                            Copy(reflags, mg->mg_ptr+2, left, char);
                            Copy(":", mg->mg_ptr+left+2, 1, char);
@@ -3269,8 +3268,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 #endif
     }
     else {
-       if (ckWARN(WARN_UNINITIALIZED)
-           && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+       if (!PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP) && ckWARN(WARN_UNINITIALIZED))
            report_uninit(sv);
        if (lp)
        *lp = 0;
@@ -4578,7 +4576,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
             }
             SvFAKE_off(sv);
             SvREADONLY_off(sv);
-            /* This SV doesn't own the buffer, so need to New() a new one:  */
+            /* This SV doesn't own the buffer, so need to Newx() a new one:  */
             SvPV_set(sv, (char*)0);
             SvLEN_set(sv, 0);
             if (flags & SV_COW_DROP_PV) {
@@ -4917,7 +4915,7 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, const MGVTBL *vtable,
     if (SvTYPE(sv) < SVt_PVMG) {
        SvUPGRADE(sv, SVt_PVMG);
     }
-    Newz(702,mg, 1, MAGIC);
+    Newxz(mg, 1, MAGIC);
     mg->mg_moremagic = SvMAGIC(sv);
     SvMAGIC_set(sv, mg);
 
@@ -5868,7 +5866,7 @@ S_utf8_mg_pos_init(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i,
        if ((*mgp)->mg_ptr)
            *cachep = (STRLEN *) (*mgp)->mg_ptr;
        else {
-           Newz(0, *cachep, PERL_MAGIC_UTF8_CACHESIZE * 2, STRLEN);
+           Newxz(*cachep, PERL_MAGIC_UTF8_CACHESIZE * 2, STRLEN);
            (*mgp)->mg_ptr = (char *) *cachep;
        }
        assert(*cachep);
@@ -6190,7 +6188,7 @@ Perl_sv_pos_b2u(pTHX_ register SV* sv, I32* offsetp)
            assert(mg);
 
            if (!mg->mg_ptr) {
-               Newz(0, cache, PERL_MAGIC_UTF8_CACHESIZE * 2, STRLEN);
+               Newxz(cache, PERL_MAGIC_UTF8_CACHESIZE * 2, STRLEN);
                mg->mg_ptr = (char *) cache;
            }
            assert(cache);
@@ -6789,7 +6787,7 @@ thats_really_all_folks:
        /*The big, slow, and stupid way. */
 #ifdef USE_HEAP_INSTEAD_OF_STACK       /* Even slower way. */
        STDCHAR *buf = 0;
-       New(0, buf, 8192, STDCHAR);
+       Newx(buf, 8192, STDCHAR);
        assert(buf);
 #else
        STDCHAR buf[8192];
@@ -7067,7 +7065,7 @@ Perl_sv_dec(pTHX_ register SV *sv)
            }
            else {
                (void)SvIOK_only_UV(sv);
-               SvUV_set(sv, SvUVX(sv) + 1);
+               SvUV_set(sv, SvUVX(sv) - 1);
            }   
        } else {
            if (SvIVX(sv) == IV_MIN)
@@ -9051,9 +9049,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
        }
 
        if (!asterisk)
+       {
            if( *q == '0' )
                fill = *q++;
            EXPECT_NUMBER(q, width);
+       }
 
        if (vectorize) {
            if (vectorarg) {
@@ -9599,7 +9599,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            if (PL_efloatsize < need) {
                Safefree(PL_efloatbuf);
                PL_efloatsize = need + 20; /* more fudge */
-               New(906, PL_efloatbuf, PL_efloatsize, char);
+               Newx(PL_efloatbuf, PL_efloatsize, char);
                PL_efloatbuf[0] = '\0';
            }
 
@@ -9691,8 +9691,10 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 
        default:
       unknown:
-           if (!args && ckWARN(WARN_PRINTF) &&
-                 (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF)) {
+           if (!args
+               && (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF)
+               && ckWARN(WARN_PRINTF))
+           {
                SV *msg = sv_newmortal();
                Perl_sv_setpvf(aTHX_ msg, "Invalid conversion in %sprintf: ",
                          (PL_op->op_type == OP_PRTF) ? "" : "s");
@@ -9857,15 +9859,15 @@ Perl_re_dup(pTHX_ const REGEXP *r, CLONE_PARAMS *param)
     len = r->offsets[0];
     npar = r->nparens+1;
 
-    Newc(0, ret, sizeof(regexp) + (len+1)*sizeof(regnode), char, regexp);
+    Newxc(ret, sizeof(regexp) + (len+1)*sizeof(regnode), char, regexp);
     Copy(r->program, ret->program, len+1, regnode);
 
-    New(0, ret->startp, npar, I32);
+    Newx(ret->startp, npar, I32);
     Copy(r->startp, ret->startp, npar, I32);
-    New(0, ret->endp, npar, I32);
+    Newx(ret->endp, npar, I32);
     Copy(r->startp, ret->startp, npar, I32);
 
-    New(0, ret->substrs, 1, struct reg_substr_data);
+    Newx(ret->substrs, 1, struct reg_substr_data);
     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;
@@ -9879,9 +9881,9 @@ Perl_re_dup(pTHX_ const REGEXP *r, CLONE_PARAMS *param)
         const int count = r->data->count;
        int i;
 
-       Newc(0, d, sizeof(struct reg_data) + count*sizeof(void *),
+       Newxc(d, sizeof(struct reg_data) + count*sizeof(void *),
                char, struct reg_data);
-       New(0, d->what, count, U8);
+       Newx(d->what, count, U8);
 
        d->count = count;
        for (i = 0; i < count; i++) {
@@ -9897,7 +9899,7 @@ Perl_re_dup(pTHX_ const REGEXP *r, CLONE_PARAMS *param)
                break;
            case 'f':
                /* This is cheating. */
-               New(0, d->data[i], 1, struct regnode_charclass_class);
+               Newx(d->data[i], 1, struct regnode_charclass_class);
                StructCopy(r->data->data[i], d->data[i],
                            struct regnode_charclass_class);
                ret->regstclass = (regnode*)d->data[i];
@@ -9928,7 +9930,7 @@ Perl_re_dup(pTHX_ const REGEXP *r, CLONE_PARAMS *param)
     else
        ret->data = NULL;
 
-    New(0, ret->offsets, 2*len+1, U32);
+    Newx(ret->offsets, 2*len+1, U32);
     Copy(r->offsets, ret->offsets, 2*len+1, U32);
 
     ret->precomp        = SAVEPVN(r->precomp, r->prelen);
@@ -10002,7 +10004,7 @@ Perl_gp_dup(pTHX_ GP *gp, CLONE_PARAMS* param)
        return ret;
 
     /* create anew and remember what it is */
-    Newz(0, ret, 1, GP);
+    Newxz(ret, 1, GP);
     ptr_table_store(PL_ptr_table, gp, ret);
 
     /* clone */
@@ -10036,7 +10038,7 @@ Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS* param)
 
     for (; mg; mg = mg->mg_moremagic) {
        MAGIC *nmg;
-       Newz(0, nmg, 1, MAGIC);
+       Newxz(nmg, 1, MAGIC);
        if (mgprev)
            mgprev->mg_moremagic = nmg;
        else
@@ -10100,10 +10102,10 @@ PTR_TBL_t *
 Perl_ptr_table_new(pTHX)
 {
     PTR_TBL_t *tbl;
-    Newz(0, tbl, 1, PTR_TBL_t);
+    Newxz(tbl, 1, PTR_TBL_t);
     tbl->tbl_max       = 511;
     tbl->tbl_items     = 0;
-    Newz(0, tbl->tbl_ary, tbl->tbl_max + 1, PTR_TBL_ENT_t*);
+    Newxz(tbl->tbl_ary, tbl->tbl_max + 1, PTR_TBL_ENT_t*);
     return tbl;
 }
 
@@ -10548,7 +10550,7 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
                    SSize_t items = AvFILLp((AV*)sstr) + 1;
 
                    src_ary = AvARRAY((AV*)sstr);
-                   Newz(0, dst_ary, AvMAX((AV*)sstr)+1, SV*);
+                   Newxz(dst_ary, AvMAX((AV*)sstr)+1, SV*);
                    ptr_table_store(PL_ptr_table, src_ary, dst_ary);
                    SvPV_set(dstr, (char*)dst_ary);
                    AvALLOC((AV*)dstr) = dst_ary;
@@ -10580,8 +10582,7 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
                        XPVHV * const dxhv = (XPVHV*)SvANY(dstr);
                        XPVHV * const sxhv = (XPVHV*)SvANY(sstr);
                        char *darray;
-                       New(0, darray,
-                           PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1)
+                       Newx(darray, PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1)
                            + (SvOOK(sstr) ? sizeof(struct xpvhv_aux) : 0),
                            char);
                        HvARRAY(dstr) = (HE**)darray;
@@ -10669,7 +10670,7 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
        return ncxs;
 
     /* create anew and remember what it is */
-    Newz(56, ncxs, max + 1, PERL_CONTEXT);
+    Newxz(ncxs, max + 1, PERL_CONTEXT);
     ptr_table_store(PL_ptr_table, cxs, ncxs);
 
     while (ix >= 0) {
@@ -10759,7 +10760,7 @@ Perl_si_dup(pTHX_ PERL_SI *si, CLONE_PARAMS* param)
        return nsi;
 
     /* create anew and remember what it is */
-    Newz(56, nsi, 1, PERL_SI);
+    Newxz(nsi, 1, PERL_SI);
     ptr_table_store(PL_ptr_table, si, nsi);
 
     nsi->si_stack      = av_dup_inc(si->si_stack, param);
@@ -10843,7 +10844,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
     void (*dptr) (void*);
     void (*dxptr) (pTHX_ void*);
 
-    Newz(54, nss, max, ANY);
+    Newxz(nss, max, ANY);
 
     while (ix > 0) {
        I32 i = POPINT(ss,ix);
@@ -11375,6 +11376,10 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     param->stashes      = newAV();  /* Setup array of objects to call clone on */
 
+    /* Set tainting stuff before PerlIO_debug can possibly get called */
+    PL_tainting                = proto_perl->Itainting;
+    PL_taint_warn      = proto_perl->Itaint_warn;
+
 #ifdef PERLIO_LAYERS
     /* Clone PerlIO tables as soon as we can handle general xx_dup() */
     PerlIO_clone(aTHX_ proto_perl, param);
@@ -11496,8 +11501,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_fdpid           = av_dup_inc(proto_perl->Ifdpid, param);
 
     /* internal state */
-    PL_tainting                = proto_perl->Itainting;
-    PL_taint_warn       = proto_perl->Itaint_warn;
     PL_maxo            = proto_perl->Imaxo;
     if (proto_perl->Iop_mask)
        PL_op_mask      = SAVEPVN(proto_perl->Iop_mask, PL_maxo);
@@ -11533,7 +11536,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     /* interpreter atexit processing */
     PL_exitlistlen     = proto_perl->Iexitlistlen;
     if (PL_exitlistlen) {
-       New(0, PL_exitlist, PL_exitlistlen, PerlExitListEntry);
+       Newx(PL_exitlist, PL_exitlistlen, PerlExitListEntry);
        Copy(proto_perl->Iexitlist, PL_exitlist, PL_exitlistlen, PerlExitListEntry);
     }
     else
@@ -11750,15 +11753,15 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_bitcount                = Nullch;       /* reinits on demand */
 
     if (proto_perl->Ipsig_pend) {
-       Newz(0, PL_psig_pend, SIG_SIZE, int);
+       Newxz(PL_psig_pend, SIG_SIZE, int);
     }
     else {
        PL_psig_pend    = (int*)NULL;
     }
 
     if (proto_perl->Ipsig_ptr) {
-       Newz(0, PL_psig_ptr,  SIG_SIZE, SV*);
-       Newz(0, PL_psig_name, SIG_SIZE, SV*);
+       Newxz(PL_psig_ptr,  SIG_SIZE, SV*);
+       Newxz(PL_psig_name, SIG_SIZE, SV*);
        for (i = 1; i < SIG_SIZE; i++) {
            PL_psig_ptr[i]  = sv_dup_inc(proto_perl->Ipsig_ptr[i], param);
            PL_psig_name[i] = sv_dup_inc(proto_perl->Ipsig_name[i], param);
@@ -11776,7 +11779,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
        PL_tmps_ix              = proto_perl->Ttmps_ix;
        PL_tmps_max             = proto_perl->Ttmps_max;
        PL_tmps_floor           = proto_perl->Ttmps_floor;
-       Newz(50, PL_tmps_stack, PL_tmps_max, SV*);
+       Newxz(PL_tmps_stack, PL_tmps_max, SV*);
        i = 0;
        while (i <= PL_tmps_ix) {
            PL_tmps_stack[i]    = sv_dup_inc(proto_perl->Ttmps_stack[i], param);
@@ -11785,7 +11788,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
        /* next PUSHMARK() sets *(PL_markstack_ptr+1) */
        i = proto_perl->Tmarkstack_max - proto_perl->Tmarkstack;
-       Newz(54, PL_markstack, i, I32);
+       Newxz(PL_markstack, i, I32);
        PL_markstack_max        = PL_markstack + (proto_perl->Tmarkstack_max
                                                  - proto_perl->Tmarkstack);
        PL_markstack_ptr        = PL_markstack + (proto_perl->Tmarkstack_ptr
@@ -11797,7 +11800,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
         * NOTE: unlike the others! */
        PL_scopestack_ix        = proto_perl->Tscopestack_ix;
        PL_scopestack_max       = proto_perl->Tscopestack_max;
-       Newz(54, PL_scopestack, PL_scopestack_max, I32);
+       Newxz(PL_scopestack, PL_scopestack_max, I32);
        Copy(proto_perl->Tscopestack, PL_scopestack, PL_scopestack_ix, I32);
 
        /* NOTE: si_dup() looks at PL_markstack */
@@ -11817,7 +11820,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
         * NOTE: unlike the others! */
        PL_savestack_ix         = proto_perl->Tsavestack_ix;
        PL_savestack_max        = proto_perl->Tsavestack_max;
-       /*Newz(54, PL_savestack, PL_savestack_max, ANY);*/
+       /*Newxz(PL_savestack, PL_savestack_max, ANY);*/
        PL_savestack            = ss_dup(proto_perl, param);
     }
     else {