This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Removed cpan/File-CheckTree
[perl5.git] / sv.c
diff --git a/sv.c b/sv.c
index 73fa710..ba09305 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -884,7 +884,7 @@ static const struct body_details bodies_by_type[] = {
     /* The bind placeholder pretends to be an RV for now.
        Also it's marked as "can't upgrade" to stop anyone using it before it's
        implemented.  */
-    { 0, 0, 0, SVt_BIND, TRUE, NONV, NOARENA, 0 },
+    { 0, 0, 0, SVt_DUMMY, TRUE, NONV, NOARENA, 0 },
 
     /* IVs are in the head, so the allocation size is 0.  */
     { 0,
@@ -1246,12 +1246,12 @@ Perl_sv_upgrade(pTHX_ SV *const sv, svtype new_type)
        assert(!SvPAD_TYPED(sv));
        break;
     default:
-       if (old_type_details->cant_upgrade)
+       if (UNLIKELY(old_type_details->cant_upgrade))
            Perl_croak(aTHX_ "Can't upgrade %s (%" UVuf ") to %" UVuf,
                       sv_reftype(sv, 0), (UV) old_type, (UV) new_type);
     }
 
-    if (old_type > new_type)
+    if (UNLIKELY(old_type > new_type))
        Perl_croak(aTHX_ "sv_upgrade from type %d down to type %d",
                (int)old_type, (int)new_type);
 
@@ -1386,7 +1386,7 @@ Perl_sv_upgrade(pTHX_ SV *const sv, svtype new_type)
            SvNV_set(sv, 0);
 #endif
 
-       if (new_type == SVt_PVIO) {
+       if (UNLIKELY(new_type == SVt_PVIO)) {
            IO * const io = MUTABLE_IO(sv);
            GV *iogv = gv_fetchpvs("IO::File::", GV_ADD, SVt_PVHV);
 
@@ -1399,7 +1399,7 @@ Perl_sv_upgrade(pTHX_ SV *const sv, svtype new_type)
            SvSTASH_set(io, MUTABLE_HV(SvREFCNT_inc(GvHV(iogv))));
            IoPAGE_LEN(sv) = 60;
        }
-       if (new_type == SVt_REGEXP)
+       if (UNLIKELY(new_type == SVt_REGEXP))
            sv->sv_u.svu_rx = (regexp *)new_body;
        else if (old_type < SVt_PV) {
            /* referant will be NULL unless the old type was SVt_IV emulating
@@ -4073,7 +4073,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags)
        }
        break;
 
-       /* case SVt_BIND: */
+       /* case SVt_DUMMY: */
     case SVt_PVLV:
     case SVt_PVGV:
     case SVt_PVMG:
@@ -6136,7 +6136,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
                SvREFCNT_dec(SvSTASH(sv));
        }
        switch (type) {
-           /* case SVt_BIND: */
+           /* case SVt_DUMMY: */
        case SVt_PVIO:
            if (IoIFP(sv) &&
                IoIFP(sv) != PerlIO_stdin() &&
@@ -6257,6 +6257,8 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
                PL_last_in_gv = NULL;
            else if ((const GV *)sv == PL_statgv)
                PL_statgv = NULL;
+            else if ((const GV *)sv == PL_stderrgv)
+                PL_stderrgv = NULL;
        case SVt_PVMG:
        case SVt_PVNV:
        case SVt_PVIV:
@@ -6409,9 +6411,9 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
                continue;
            }
 #endif
-           if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
+           if (SvIMMORTAL(sv)) {
                /* make sure SvREFCNT(sv)==0 happens very seldom */
-               SvREFCNT(sv) = (~(U32)0)/2;
+               SvREFCNT(sv) = SvREFCNT_IMMORTAL;
                continue;
            }
            break;
@@ -6511,8 +6513,6 @@ S_curse(pTHX_ SV * const sv, const bool check_refcnt) {
        SvOBJECT_off(sv);       /* Curse the object. */
        SvSTASH_set(sv,0);      /* SvREFCNT_dec may try to read this */
        SvREFCNT_dec(stash); /* possibly of changed persuasion */
-       if (SvTYPE(sv) != SVt_PVIO)
-           --PL_sv_objcount;/* XXX Might want something more general */
     }
     return TRUE;
 }
@@ -6575,9 +6575,9 @@ Perl_sv_free2(pTHX_ SV *const sv, const U32 rc)
             return;
         }
 #endif
-        if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
+        if (SvIMMORTAL(sv)) {
             /* make sure SvREFCNT(sv)==0 happens very seldom */
-            SvREFCNT(sv) = (~(U32)0)/2;
+            SvREFCNT(sv) = SvREFCNT_IMMORTAL;
             return;
         }
         sv_clear(sv);
@@ -6596,9 +6596,9 @@ Perl_sv_free2(pTHX_ SV *const sv, const U32 rc)
         return;
     if (PL_in_clean_all) /* All is fair */
         return;
-    if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
+    if (SvIMMORTAL(sv)) {
         /* make sure SvREFCNT(sv)==0 happens very seldom */
-        SvREFCNT(sv) = (~(U32)0)/2;
+        SvREFCNT(sv) = SvREFCNT_IMMORTAL;
         return;
     }
     if (ckWARN_d(WARN_INTERNAL)) {
@@ -7437,7 +7437,6 @@ Perl_sv_cmp_flags(pTHX_ SV *const sv1, SV *const sv2,
     dVAR;
     STRLEN cur1, cur2;
     const char *pv1, *pv2;
-    char *tpv = NULL;
     I32  cmp;
     SV *svrecode = NULL;
 
@@ -7501,8 +7500,6 @@ Perl_sv_cmp_flags(pTHX_ SV *const sv1, SV *const sv2,
     }
 
     SvREFCNT_dec(svrecode);
-    if (tpv)
-       Safefree(tpv);
 
     return cmp;
 }
@@ -8572,7 +8569,7 @@ Perl_sv_2mortal(pTHX_ SV *const sv)
     dVAR;
     if (!sv)
        return NULL;
-    if (SvREADONLY(sv) && SvIMMORTAL(sv))
+    if (SvIMMORTAL(sv))
        return sv;
     PUSH_EXTEND_MORTAL__SV_C(sv);
     SvTEMP_on(sv);
@@ -9409,7 +9406,7 @@ Perl_sv_reftype(pTHX_ const SV *const sv, const int ob)
                                    ? "GLOB" : "SCALAR");
        case SVt_PVFM:          return "FORMAT";
        case SVt_PVIO:          return "IO";
-       case SVt_BIND:          return "BIND";
+       case SVt_DUMMY:         return "DUMMY";
        case SVt_REGEXP:        return "REGEXP";
        default:                return "UNKNOWN";
        }
@@ -9503,10 +9500,10 @@ Perl_sv_isa(pTHX_ SV *sv, const char *const name)
 /*
 =for apidoc newSVrv
 
-Creates a new SV for the RV, C<rv>, to point to.  If C<rv> is not an RV then
-it will be upgraded to one.  If C<classname> is non-null then the new SV will
-be blessed in the specified package.  The new SV is returned and its
-reference count is 1.
+Creates a new SV for the existing RV, C<rv>, to point to.  If C<rv> is not an
+RV then it will be upgraded to one.  If C<classname> is non-null then the new
+SV will be blessed in the specified package.  The new SV is returned and its
+reference count is 1. The reference count 1 is owned by C<rv>.
 
 =cut
 */
@@ -9695,14 +9692,10 @@ Perl_sv_bless(pTHX_ SV *const sv, HV *const stash)
        if (SvREADONLY(tmpRef) && !SvIsCOW(tmpRef))
            Perl_croak_no_modify();
        if (SvOBJECT(tmpRef)) {
-           if (SvTYPE(tmpRef) != SVt_PVIO)
-               --PL_sv_objcount;
            SvREFCNT_dec(SvSTASH(tmpRef));
        }
     }
     SvOBJECT_on(tmpRef);
-    if (SvTYPE(tmpRef) != SVt_PVIO)
-       ++PL_sv_objcount;
     SvUPGRADE(tmpRef, SVt_PVMG);
     SvSTASH_set(tmpRef, MUTABLE_HV(SvREFCNT_inc_simple(stash)));
 
@@ -11332,13 +11325,13 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
 
        have = esignlen + zeros + elen;
        if (have < zeros)
-           croak_memory_wrap();
+           Perl_croak_memory_wrap();
 
        need = (have > width ? have : width);
        gap = need - have;
 
        if (need >= (((STRLEN)~0) - SvCUR(sv) - dotstrlen - 1))
-           croak_memory_wrap();
+           Perl_croak_memory_wrap();
        SvGROW(sv, SvCUR(sv) + need + dotstrlen + 1);
        p = SvEND(sv);
        if (esignlen && fill == '0') {
@@ -12140,7 +12133,7 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
        SvANY(dstr)     = new_XNV();
        SvNV_set(dstr, SvNVX(sstr));
        break;
-       /* case SVt_BIND: */
+       /* case SVt_DUMMY: */
     default:
        {
            /* These are all the types that need complex bodies allocating.  */
@@ -12438,9 +12431,6 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
        }
     }
 
-    if (SvOBJECT(dstr) && SvTYPE(dstr) != SVt_PVIO)
-       ++PL_sv_objcount;
-
     return dstr;
  }
 
@@ -13137,7 +13127,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     Zero(&PL_body_roots, 1, PL_body_roots);
     
     PL_sv_count                = 0;
-    PL_sv_objcount     = 0;
     PL_sv_root         = NULL;
     PL_sv_arenaroot    = NULL;
 
@@ -13588,68 +13577,21 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_ASCII           = sv_dup_inc(proto_perl->IASCII, param);
     PL_Latin1          = sv_dup_inc(proto_perl->ILatin1, param);
 
-    PL_PerlSpace       = sv_dup_inc(proto_perl->IPerlSpace, param);
-    PL_XPerlSpace      = sv_dup_inc(proto_perl->IXPerlSpace, param);
-
-    PL_L1PosixAlnum    = sv_dup_inc(proto_perl->IL1PosixAlnum, param);
-    PL_PosixAlnum      = sv_dup_inc(proto_perl->IPosixAlnum, param);
-
-    PL_L1PosixAlpha    = sv_dup_inc(proto_perl->IL1PosixAlpha, param);
-    PL_PosixAlpha      = sv_dup_inc(proto_perl->IPosixAlpha, param);
-
-    PL_PosixBlank      = sv_dup_inc(proto_perl->IPosixBlank, param);
-    PL_XPosixBlank     = sv_dup_inc(proto_perl->IXPosixBlank, param);
-
-    PL_L1Cased         = sv_dup_inc(proto_perl->IL1Cased, param);
-
-    PL_PosixCntrl      = sv_dup_inc(proto_perl->IPosixCntrl, param);
-    PL_XPosixCntrl     = sv_dup_inc(proto_perl->IXPosixCntrl, param);
-
-    PL_PosixDigit      = sv_dup_inc(proto_perl->IPosixDigit, param);
-
-    PL_L1PosixGraph    = sv_dup_inc(proto_perl->IL1PosixGraph, param);
-    PL_PosixGraph      = sv_dup_inc(proto_perl->IPosixGraph, param);
-
-    PL_L1PosixLower    = sv_dup_inc(proto_perl->IL1PosixLower, param);
-    PL_PosixLower      = sv_dup_inc(proto_perl->IPosixLower, param);
-
-    PL_L1PosixPrint    = sv_dup_inc(proto_perl->IL1PosixPrint, param);
-    PL_PosixPrint      = sv_dup_inc(proto_perl->IPosixPrint, param);
-
-    PL_L1PosixPunct    = sv_dup_inc(proto_perl->IL1PosixPunct, param);
-    PL_PosixPunct      = sv_dup_inc(proto_perl->IPosixPunct, param);
-
-    PL_PosixSpace      = sv_dup_inc(proto_perl->IPosixSpace, param);
-    PL_XPosixSpace     = sv_dup_inc(proto_perl->IXPosixSpace, param);
-
-    PL_L1PosixUpper    = sv_dup_inc(proto_perl->IL1PosixUpper, param);
-    PL_PosixUpper      = sv_dup_inc(proto_perl->IPosixUpper, param);
-
-    PL_L1PosixWord     = sv_dup_inc(proto_perl->IL1PosixWord, param);
-    PL_PosixWord       = sv_dup_inc(proto_perl->IPosixWord, param);
-
-    PL_PosixXDigit     = sv_dup_inc(proto_perl->IPosixXDigit, param);
-    PL_XPosixXDigit    = sv_dup_inc(proto_perl->IXPosixXDigit, param);
-
-    PL_VertSpace       = sv_dup_inc(proto_perl->IVertSpace, param);
-
     PL_NonL1NonFinalFold = sv_dup_inc(proto_perl->INonL1NonFinalFold, param);
     PL_HasMultiCharFold= sv_dup_inc(proto_perl->IHasMultiCharFold, param);
 
     /* utf8 character class swashes */
-    PL_utf8_alnum      = sv_dup_inc(proto_perl->Iutf8_alnum, param);
-    PL_utf8_alnumc     = sv_dup_inc(proto_perl->Iutf8_alnumc, param);
-    PL_utf8_alpha      = sv_dup_inc(proto_perl->Iutf8_alpha, param);
-    PL_utf8_graph      = sv_dup_inc(proto_perl->Iutf8_graph, param);
-    PL_utf8_digit      = sv_dup_inc(proto_perl->Iutf8_digit, param);
-    PL_utf8_upper      = sv_dup_inc(proto_perl->Iutf8_upper, param);
-    PL_utf8_lower      = sv_dup_inc(proto_perl->Iutf8_lower, param);
-    PL_utf8_print      = sv_dup_inc(proto_perl->Iutf8_print, param);
-    PL_utf8_punct      = sv_dup_inc(proto_perl->Iutf8_punct, param);
+    for (i = 0; i < POSIX_SWASH_COUNT; i++) {
+        PL_utf8_swash_ptrs[i] = sv_dup_inc(proto_perl->Iutf8_swash_ptrs[i], param);
+    }
+    for (i = 0; i < POSIX_CC_COUNT; i++) {
+        PL_Posix_ptrs[i] = sv_dup_inc(proto_perl->IPosix_ptrs[i], param);
+        PL_L1Posix_ptrs[i] = sv_dup_inc(proto_perl->IL1Posix_ptrs[i], param);
+        PL_XPosix_ptrs[i] = sv_dup_inc(proto_perl->IXPosix_ptrs[i], param);
+    }
     PL_utf8_mark       = sv_dup_inc(proto_perl->Iutf8_mark, param);
     PL_utf8_X_regular_begin    = sv_dup_inc(proto_perl->Iutf8_X_regular_begin, param);
     PL_utf8_X_extend   = sv_dup_inc(proto_perl->Iutf8_X_extend, param);
-    PL_utf8_X_LVT      = sv_dup_inc(proto_perl->Iutf8_X_LVT, param);
     PL_utf8_toupper    = sv_dup_inc(proto_perl->Iutf8_toupper, param);
     PL_utf8_totitle    = sv_dup_inc(proto_perl->Iutf8_totitle, param);
     PL_utf8_tolower    = sv_dup_inc(proto_perl->Iutf8_tolower, param);
@@ -13657,6 +13599,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_utf8_idstart    = sv_dup_inc(proto_perl->Iutf8_idstart, param);
     PL_utf8_xidstart   = sv_dup_inc(proto_perl->Iutf8_xidstart, param);
     PL_utf8_perl_idstart = sv_dup_inc(proto_perl->Iutf8_perl_idstart, param);
+    PL_utf8_perl_idcont = sv_dup_inc(proto_perl->Iutf8_perl_idcont, param);
     PL_utf8_idcont     = sv_dup_inc(proto_perl->Iutf8_idcont, param);
     PL_utf8_xidcont    = sv_dup_inc(proto_perl->Iutf8_xidcont, param);
     PL_utf8_foldable   = sv_dup_inc(proto_perl->Iutf8_foldable, param);
@@ -13914,18 +13857,18 @@ Perl_clone_params_new(PerlInterpreter *const from, PerlInterpreter *const to)
 void
 Perl_init_constants(pTHX)
 {
-    SvREFCNT(&PL_sv_undef)     = (~(U32)0)/2;
+    SvREFCNT(&PL_sv_undef)     = SvREFCNT_IMMORTAL;
     SvFLAGS(&PL_sv_undef)      = SVf_READONLY|SVt_NULL;
     SvANY(&PL_sv_undef)                = NULL;
 
     SvANY(&PL_sv_no)           = new_XPVNV();
-    SvREFCNT(&PL_sv_no)                = (~(U32)0)/2;
+    SvREFCNT(&PL_sv_no)                = SvREFCNT_IMMORTAL;
     SvFLAGS(&PL_sv_no)         = SVt_PVNV|SVf_READONLY
                                  |SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK
                                  |SVp_POK|SVf_POK;
 
     SvANY(&PL_sv_yes)          = new_XPVNV();
-    SvREFCNT(&PL_sv_yes)       = (~(U32)0)/2;
+    SvREFCNT(&PL_sv_yes)       = SvREFCNT_IMMORTAL;
     SvFLAGS(&PL_sv_yes)                = SVt_PVNV|SVf_READONLY
                                  |SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK
                                  |SVp_POK|SVf_POK;