This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Disallow setting SvPV on formats
authorFather Chrysostomos <sprout@cpan.org>
Sun, 5 Aug 2012 07:34:11 +0000 (00:34 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 5 Aug 2012 20:18:57 +0000 (13:18 -0700)
Setting a the PV on a format is meaningless, as of the previ-
ous commit.

This frees up SvCUR for other uses.

dump.c
sv.c

diff --git a/dump.c b/dump.c
index c7a40a6..ca5d125 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1609,7 +1609,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        return;
     }
 
-    if ((type <= SVt_PVLV && !isGV_with_GP(sv)) || type == SVt_PVFM) {
+    if (type <= SVt_PVLV && !isGV_with_GP(sv)) {
        if (SvPVX_const(sv)) {
            STRLEN delta;
            if (SvOOK(sv)) {
diff --git a/sv.c b/sv.c
index dd4f19a..8d5d62b 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3984,15 +3984,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
        }
        goto undef_sstr;
 
-    case SVt_PVFM:
-#ifdef PERL_OLD_COPY_ON_WRITE
-       if ((SvFLAGS(sstr) & CAN_COW_MASK) == CAN_COW_FLAGS) {
-           if (dtype < SVt_PVIV)
-               sv_upgrade(dstr, SVt_PVIV);
-           break;
-       }
-       /* Fall through */
-#endif
     case SVt_PV:
        if (dtype < SVt_PV)
            sv_upgrade(dstr, SVt_PV);
@@ -4045,7 +4036,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
     dtype = SvTYPE(dstr);
     sflags = SvFLAGS(sstr);
 
-    if (dtype == SVt_PVCV || dtype == SVt_PVFM) {
+    if (dtype == SVt_PVCV) {
        /* Assigning to a subroutine sets the prototype.  */
        if (SvOK(sstr)) {
            STRLEN len;
@@ -4060,7 +4051,8 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
        } else {
            SvOK_off(dstr);
        }
-    } else if (dtype == SVt_PVAV || dtype == SVt_PVHV) {
+    }
+    else if (dtype == SVt_PVAV || dtype == SVt_PVHV || dtype == SVt_PVFM) {
        const char * const type = sv_reftype(dstr,0);
        if (PL_op)
            /* diag_listed_as: Cannot copy to %s */
@@ -4203,7 +4195,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
             && ((flags & SV_COW_SHARED_HASH_KEYS)
                ? (!((sflags & CAN_COW_MASK) == CAN_COW_FLAGS
                     && (SvFLAGS(dstr) & CAN_COW_MASK) == CAN_COW_FLAGS
-                    && SvTYPE(sstr) >= SVt_PVIV && SvTYPE(sstr) != SVt_PVFM))
+                    && SvTYPE(sstr) >= SVt_PVIV))
                : 1)
 #endif
             ) {
@@ -9052,7 +9044,7 @@ Perl_sv_pvn_force_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
            else
                Perl_croak(aTHX_ "Can't coerce readonly %s to string", ref);
        }
-       if ((SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM)
+       if (SvTYPE(sv) > SVt_PVLV
            || isGV_with_GP(sv))
            /* 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),