This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Sync Module-CoreList in Maintainers.pl with CPAN
[perl5.git] / sv.c
diff --git a/sv.c b/sv.c
index d6bc23e..4a57a9a 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -4785,7 +4785,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *const sv, const U32 flags)
             }
        }
        else if (IN_PERL_RUNTIME)
-           Perl_croak_no_modify(aTHX);
+           Perl_croak_no_modify();
     }
 #else
     if (SvREADONLY(sv)) {
@@ -4807,7 +4807,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *const sv, const U32 flags)
            unshare_hek(SvSHARED_HEK_FROM_PV(pvx));
        }
        else if (IN_PERL_RUNTIME)
-           Perl_croak_no_modify(aTHX);
+           Perl_croak_no_modify();
     }
 #endif
     if (SvROK(sv))
@@ -5320,7 +5320,7 @@ Perl_sv_magic(pTHX_ register SV *const sv, SV *const obj, const int how,
            && !PERL_MAGIC_TYPE_READONLY_ACCEPTABLE(how)
           )
        {
-           Perl_croak_no_modify(aTHX);
+           Perl_croak_no_modify();
        }
     }
     if (SvMAGICAL(sv) || (how == PERL_MAGIC_taint && SvTYPE(sv) >= SVt_PVMG)) {
@@ -7954,7 +7954,7 @@ Perl_sv_inc_nomg(pTHX_ register SV *const sv)
            sv_force_normal_flags(sv, 0);
        if (SvREADONLY(sv)) {
            if (IN_PERL_RUNTIME)
-               Perl_croak_no_modify(aTHX);
+               Perl_croak_no_modify();
        }
        if (SvROK(sv)) {
            IV i;
@@ -8136,7 +8136,7 @@ Perl_sv_dec_nomg(pTHX_ register SV *const sv)
            sv_force_normal_flags(sv, 0);
        if (SvREADONLY(sv)) {
            if (IN_PERL_RUNTIME)
-               Perl_croak_no_modify(aTHX);
+               Perl_croak_no_modify();
        }
        if (SvROK(sv)) {
            IV i;
@@ -9495,7 +9495,7 @@ Perl_sv_bless(pTHX_ SV *const sv, HV *const stash)
     tmpRef = SvRV(sv);
     if (SvFLAGS(tmpRef) & (SVs_OBJECT|SVf_READONLY)) {
        if (SvREADONLY(tmpRef) && !SvIsCOW(tmpRef))
-           Perl_croak_no_modify(aTHX);
+           Perl_croak_no_modify();
        if (SvOBJECT(tmpRef)) {
            if (SvTYPE(tmpRef) != SVt_PVIO)
                --PL_sv_objcount;
@@ -12493,6 +12493,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
        TOPUV(nss,ix) = uv;
        switch (type) {
        case SAVEt_CLEARSV:
+       case SAVEt_CLEARPADRANGE:
            break;
        case SAVEt_HELEM:               /* hash element */
            sv = (const SV *)POPPTR(ss,ix);
@@ -12948,9 +12949,14 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_origargc                = proto_perl->Iorigargc;
     PL_origargv                = proto_perl->Iorigargv;
 
+#if !NO_TAINT_SUPPORT
     /* Set tainting stuff before PerlIO_debug can possibly get called */
     PL_tainting                = proto_perl->Itainting;
     PL_taint_warn      = proto_perl->Itaint_warn;
+#else
+    PL_tainting         = FALSE;
+    PL_taint_warn      = FALSE;
+#endif
 
     PL_minus_c         = proto_perl->Iminus_c;
 
@@ -13123,7 +13129,11 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_timesbuf                = proto_perl->Itimesbuf;
 #endif
 
+#if !NO_TAINT_SUPPORT
     PL_tainted         = proto_perl->Itainted;
+#else
+    PL_tainted          = FALSE;
+#endif
     PL_curpm           = proto_perl->Icurpm;   /* XXX No PMOP ref count */
 
     PL_chopset         = proto_perl->Ichopset; /* XXX never deallocated */
@@ -13448,6 +13458,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     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);
+    PL_utf8_charname_begin = sv_dup_inc(proto_perl->Iutf8_charname_begin, param);
+    PL_utf8_charname_continue = sv_dup_inc(proto_perl->Iutf8_charname_continue, param);
     PL_ASCII           = sv_dup_inc(proto_perl->IASCII, param);
     PL_AboveLatin1     = sv_dup_inc(proto_perl->IAboveLatin1, param);
     PL_Latin1          = sv_dup_inc(proto_perl->ILatin1, param);
@@ -14032,8 +14044,16 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
     case OP_PADAV:
     case OP_PADHV:
       {
-       const bool pad  = (obase->op_type == OP_PADAV || obase->op_type == OP_PADHV);
-       const bool hash = (obase->op_type == OP_PADHV || obase->op_type == OP_RV2HV);
+       const bool pad  = (    obase->op_type == OP_PADAV
+                            || obase->op_type == OP_PADHV
+                            || obase->op_type == OP_PADRANGE
+                          );
+
+       const bool hash = (    obase->op_type == OP_PADHV
+                            || obase->op_type == OP_RV2HV
+                            || (obase->op_type == OP_PADRANGE
+                                && SvTYPE(PAD_SVl(obase->op_targ)) == SVt_PVHV)
+                          );
        I32 index = 0;
        SV *keysv = NULL;
        int subscript_type = FUV_SUBSCRIPT_WITHIN;
@@ -14239,7 +14259,9 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
 
     case OP_OPEN:
        o = cUNOPx(obase)->op_first;
-       if (o->op_type == OP_PUSHMARK)
+       if (   o->op_type == OP_PUSHMARK
+          || (o->op_type == OP_NULL && o->op_targ == OP_PUSHMARK)
+        )
            o = o->op_sibling;
 
        if (!o->op_sibling) {
@@ -14283,7 +14305,10 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
        match = 1; /* print etc can return undef on defined args */
        /* skip filehandle as it can't produce 'undef' warning  */
        o = cUNOPx(obase)->op_first;
-       if ((obase->op_flags & OPf_STACKED) && o->op_type == OP_PUSHMARK)
+       if ((obase->op_flags & OPf_STACKED)
+            &&
+               (   o->op_type == OP_PUSHMARK
+               || (o->op_type == OP_NULL && o->op_targ == OP_PUSHMARK)))
            o = o->op_sibling->op_sibling;
        goto do_op2;
 
@@ -14411,6 +14436,8 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
         * left that is not skipped, then we *know* it is responsible for
         * the uninitialized value.  If there is more than one op left, we
         * have to look for an exact match in the while() loop below.
+         * Note that we skip padrange, because the individual pad ops that
+         * it replaced are still in the tree, so we work on them instead.
         */
        o2 = NULL;
        for (kid=o; kid; kid = kid->op_sibling) {
@@ -14419,6 +14446,7 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
                if ( (type == OP_CONST && SvOK(cSVOPx_sv(kid)))
                  || (type == OP_NULL  && ! (kid->op_flags & OPf_KIDS))
                  || (type == OP_PUSHMARK)
+                 || (type == OP_PADRANGE)
                )
                continue;
            }