sv.c: typo

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index 3560c27..f1fe1f2 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3645,8 +3645,8 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
            }
            SvUPGRADE(dstr, SVt_PVGV);
            (void)SvOK_off(dstr);
-           /* FIXME - why are we doing this, then turning it off and on again
-              below?  */
+           /* We have to turn this on here (even though we turn it off
+              below, as GvSTASH will fail an assertion otherwise. */
            isGV_with_GP_on(dstr);
        }
        GvSTASH(dstr) = GvSTASH(sstr);
@@ -3711,7 +3711,7 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
     }
 
     gp_free(MUTABLE_GV(dstr));
-    isGV_with_GP_off(dstr);
+    isGV_with_GP_off(dstr); /* SvOK_off does not like globs. */
     (void)SvOK_off(dstr);
     isGV_with_GP_on(dstr);
     GvINTRO_off(dstr);         /* one-shot flag */
@@ -4794,9 +4794,14 @@ Perl_sv_force_normal_flags(pTHX_ register SV *const sv, const U32 flags)
            SvREADONLY_off(sv);
            SvPV_set(sv, NULL);
            SvLEN_set(sv, 0);
-           SvGROW(sv, len + 1);
-           Move(pvx,SvPVX(sv),len,char);
-           *SvEND(sv) = '\0';
+           if (flags & SV_COW_DROP_PV) {
+               /* OK, so we don't need to copy our buffer.  */
+               SvPOK_off(sv);
+           } else {
+               SvGROW(sv, len + 1);
+               Move(pvx,SvPVX(sv),len,char);
+               *SvEND(sv) = '\0';
+           }
            unshare_hek(SvSHARED_HEK_FROM_PV(pvx));
        }
        else if (IN_PERL_RUNTIME)
@@ -4806,7 +4811,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *const sv, const U32 flags)
     if (SvROK(sv))
        sv_unref_flags(sv, flags);
     else if (SvFAKE(sv) && isGV_with_GP(sv))
-       sv_unglob(sv);
+       sv_unglob(sv, flags);
     else if (SvFAKE(sv) && SvTYPE(sv) == SVt_REGEXP) {
        /* Need to downgrade the REGEXP to a simple(r) scalar. This is analogous
           to sv_unglob. We only need it here, so inline it.  */
@@ -5711,7 +5716,8 @@ the Perl substr() function.  Handles get magic.
 
 =for apidoc sv_insert_flags
 
-Same as C<sv_insert>, but the extra C<flags> are passed the C<SvPV_force_flags> that applies to C<bigstr>.
+Same as C<sv_insert>, but the extra C<flags> are passed to the
+C<SvPV_force_flags> that applies to C<bigstr>.
 
 =cut
 */
@@ -8435,7 +8441,7 @@ Creates a new SV with its SvPVX_const pointing to a shared string in the string
 table.  If the string does not already exist in the table, it is
 created first.  Turns on READONLY and FAKE.  If the C<hash> parameter
 is non-zero, that value is used; otherwise the hash is computed.
-The string's hash can be later be retrieved from the SV
+The string's hash can later be retrieved from the SV
 with the C<SvSHARED_HASH()> macro.  The idea here is
 that as the string table is used for shared hash keys these strings will have
 SvPVX_const == HeKEY and hash lookup will avoid string compare.
@@ -8901,8 +8907,6 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **const st, GV **const gvp, const I32 lref)
        if (SvROK(sv)) {
            if (SvAMAGIC(sv))
                sv = amagic_deref_call(sv, to_cv_amg);
-           /* At this point I'd like to do SPAGAIN, but really I need to
-              force it upon my callers. Hmmm. This is a mess... */
 
            sv = SvRV(sv);
            if (SvTYPE(sv) == SVt_PVCV) {
@@ -9015,6 +9019,7 @@ Perl_sv_pvn_force_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
 
     PERL_ARGS_ASSERT_SV_PVN_FORCE_FLAGS;
 
+    if (flags & SV_GMAGIC) SvGETMAGIC(sv);
     if (SvTHINKFIRST(sv) && !SvROK(sv))
         sv_force_normal_flags(sv, 0);
 
@@ -9039,7 +9044,7 @@ Perl_sv_pvn_force_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
            /* diag_listed_as: Can't coerce %s to %s in %s */
            Perl_croak(aTHX_ "Can't coerce %s to string in %s", sv_reftype(sv,0),
                OP_DESC(PL_op));
-       s = sv_2pv_flags(sv, &len, flags);
+       s = sv_2pv_flags(sv, &len, flags &~ SV_GMAGIC);
        if (lp)
            *lp = len;
 
@@ -9463,8 +9468,8 @@ Perl_sv_bless(pTHX_ SV *const sv, HV *const stash)
  * as it is after unglobbing it.
  */
 
-STATIC void
-S_sv_unglob(pTHX_ SV *const sv)
+PERL_STATIC_INLINE void
+S_sv_unglob(pTHX_ SV *const sv, U32 flags)
 {
     dVAR;
     void *xpvmg;
@@ -9475,7 +9480,8 @@ S_sv_unglob(pTHX_ SV *const sv)
 
     assert(SvTYPE(sv) == SVt_PVGV || SvTYPE(sv) == SVt_PVLV);
     SvFAKE_off(sv);
-    gv_efullname3(temp, MUTABLE_GV(sv), "*");
+    if (!(flags & SV_COW_DROP_PV))
+       gv_efullname3(temp, MUTABLE_GV(sv), "*");
 
     if (GvGP(sv)) {
         if(GvCVu((const GV *)sv) && (stash = GvSTASH(MUTABLE_GV(sv)))
@@ -9506,7 +9512,8 @@ S_sv_unglob(pTHX_ SV *const sv)
 
     /* Intentionally not calling any local SET magic, as this isn't so much a
        set operation as merely an internal storage change.  */
-    sv_setsv_flags(sv, temp, 0);
+    if (flags & SV_COW_DROP_PV) SvOK_off(sv);
+    else sv_setsv_flags(sv, temp, 0);
 }
 
 /*
@@ -10344,7 +10351,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
                 * back into v-string notation and then let the
                 * vectorize happen normally
                 */
-               if (sv_derived_from(vecsv, "version")) {
+               if (sv_derived_from(vecsv, "version") && SvROK(vecsv)) {
                    char *version = savesvpv(vecsv);
                    if ( hv_exists(MUTABLE_HV(SvRV(vecsv)), "alpha", 5 ) ) {
                        Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
@@ -13903,9 +13910,11 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
                    break;
                sv = hash ? MUTABLE_SV(GvHV(gv)): MUTABLE_SV(GvAV(gv));
            }
-           else /* @{expr}, %{expr} */
+           else if (obase == PL_op) /* @{expr}, %{expr} */
                return find_uninit_var(cUNOPx(obase)->op_first,
                                                    uninit_sv, match);
+           else /* @{expr}, %{expr} as a sub-expression */
+               return NULL;
        }
 
        /* attempt to find a match within the aggregate */
@@ -14265,12 +14274,6 @@ 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)
-                 || (
-                     /* @$a and %$a, but not @a or %a */
-                       (type == OP_RV2AV || type == OP_RV2HV)
-                    && cUNOPx(kid)->op_first
-                    && cUNOPx(kid)->op_first->op_type != OP_GV
-                    )
                )
                continue;
            }