Move Package::Constants from lib to ext

[p5sagit/p5-mst-13.2.git] / sv.c

diff --git a/sv.c b/sv.c
index 8bfe441..a53669a 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1185,13 +1185,22 @@ Perl_sv_upgrade(pTHX_ register SV *const sv, svtype new_type)
 
     PERL_ARGS_ASSERT_SV_UPGRADE;
 
+    if (old_type == new_type)
+       return;
+
+    /* This clause was purposefully added ahead of the early return above to
+       the shared string hackery for (sort {$a <=> $b} keys %hash), with the
+       inference by Nick I-S that it would fix other troublesome cases. See
+       changes 7162, 7163 (f130fd4589cf5fbb24149cd4db4137c8326f49c1 and parent)
+
+       Given that shared hash key scalars are no longer PVIV, but PV, there is
+       no longer need to unshare so as to free up the IVX slot for its proper
+       purpose. So it's safe to move the early return earlier.  */
+
     if (new_type != SVt_PV && SvIsCOW(sv)) {
        sv_force_normal_flags(sv, 0);
     }
 
-    if (old_type == new_type)
-       return;
-
     old_body = SvANY(sv);
 
     /* Copying structures onto other structures that have been neatly zeroed
@@ -1421,8 +1430,22 @@ Perl_sv_upgrade(pTHX_ register SV *const sv, svtype new_type)
            SvNV_set(sv, 0);
 #endif
 
-       if (new_type == SVt_PVIO)
+       if (new_type == SVt_PVIO) {
+           IO * const io = MUTABLE_IO(sv);
+           GV *iogv = gv_fetchpvs("FileHandle::", 0, SVt_PVHV);
+
+           SvOBJECT_on(io);
+           /* Clear the stashcache because a new IO could overrule a package
+              name */
+           hv_clear(PL_stashcache);
+
+           /* unless exists($main::{FileHandle}) and
+              defined(%main::FileHandle::) */
+           if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
+               iogv = gv_fetchpvs("IO::Handle::", GV_ADD, SVt_PVHV);
+           SvSTASH_set(io, MUTABLE_HV(SvREFCNT_inc(GvHV(iogv))));
            IoPAGE_LEN(sv) = 60;
+       }
        if (old_type < SVt_PV) {
            /* referant will be NULL unless the old type was SVt_IV emulating
               SVt_RV */
@@ -5073,8 +5096,6 @@ Perl_sv_magic(pTHX_ register SV *const sv, SV *const obj, const int how,
     case PERL_MAGIC_qr:
        vtable = &PL_vtbl_regexp;
        break;
-    case PERL_MAGIC_hints:
-       /* As this vtable is all NULL, we can reuse it.  */
     case PERL_MAGIC_sig:
        vtable = &PL_vtbl_sig;
        break;
@@ -5117,6 +5138,9 @@ Perl_sv_magic(pTHX_ register SV *const sv, SV *const obj, const int how,
     case PERL_MAGIC_hintselem:
        vtable = &PL_vtbl_hintselem;
        break;
+    case PERL_MAGIC_hints:
+       vtable = &PL_vtbl_hints;
+       break;
     case PERL_MAGIC_ext:
        /* Reserved for use by extensions not perl internals.           */
        /* Useful for attaching extension internal data to perl vars.   */
@@ -7274,7 +7298,7 @@ Perl_sv_inc(pTHX_ register SV *const sv)
     d = SvPVX(sv);
     while (isALPHA(*d)) d++;
     while (isDIGIT(*d)) d++;
-    if (*d) {
+    if (d < SvEND(sv)) {
 #ifdef PERL_PRESERVE_IVUV
        /* Got to punt this as an integer if needs be, but we don't issue
           warnings. Probably ought to make the sv_iv_please() that does
@@ -12349,11 +12373,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_registered_mros  = hv_dup_inc(proto_perl->Iregistered_mros, param);
 
-    if (!(flags & CLONEf_KEEP_PTR_TABLE)) {
-        ptr_table_free(PL_ptr_table);
-        PL_ptr_table = NULL;
-    }
-
     /* Call the ->CLONE method, if it exists, for each of the stashes
        identified by sv_dup() above.
     */
@@ -12373,6 +12392,12 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
        }
     }
 
+    if (!(flags & CLONEf_KEEP_PTR_TABLE)) {
+        ptr_table_free(PL_ptr_table);
+        PL_ptr_table = NULL;
+    }
+
+
     SvREFCNT_dec(param->stashes);
 
     /* orphaned? eg threads->new inside BEGIN or use */