t/io/binmode.t

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

diff --git a/sv.c b/sv.c
index 1194657..e0a242e 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -2054,7 +2054,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
                ) {
                SvIOK_on(sv);  /* Can this go wrong with rounding? NWC */
                DEBUG_c(PerlIO_printf(Perl_debug_log,
-                                     "0x%"UVxf" iv(%g => %"IVdf") (precise)\n",
+                                     "0x%"UVxf" iv(%"NVgf" => %"IVdf") (precise)\n",
                                      PTR2UV(sv),
                                      SvNVX(sv),
                                      SvIVX(sv)));
@@ -2065,7 +2065,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
                   that PV->IV would be better than PV->NV->IV
                   flags already correct - don't set public IOK.  */
                DEBUG_c(PerlIO_printf(Perl_debug_log,
-                                     "0x%"UVxf" iv(%g => %"IVdf") (imprecise)\n",
+                                     "0x%"UVxf" iv(%"NVgf" => %"IVdf") (imprecise)\n",
                                      PTR2UV(sv),
                                      SvNVX(sv),
                                      SvIVX(sv)));
@@ -2348,7 +2348,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
                ) {
                SvIOK_on(sv);  /* Can this go wrong with rounding? NWC */
                DEBUG_c(PerlIO_printf(Perl_debug_log,
-                                     "0x%"UVxf" uv(%g => %"IVdf") (precise)\n",
+                                     "0x%"UVxf" uv(%"NVgf" => %"IVdf") (precise)\n",
                                      PTR2UV(sv),
                                      SvNVX(sv),
                                      SvIVX(sv)));
@@ -2359,7 +2359,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
                   that PV->IV would be better than PV->NV->IV
                   flags already correct - don't set public IOK.  */
                DEBUG_c(PerlIO_printf(Perl_debug_log,
-                                     "0x%"UVxf" uv(%g => %"IVdf") (imprecise)\n",
+                                     "0x%"UVxf" uv(%"NVgf" => %"IVdf") (imprecise)\n",
                                      PTR2UV(sv),
                                      SvNVX(sv),
                                      SvIVX(sv)));
@@ -8403,7 +8403,8 @@ Perl_re_dup(pTHX_ REGEXP *r, clone_params *param)
                ret->regstclass = (regnode*)d->data[i];
                break;
            case 'o':
-               /* XXX: can this really be shared? */
+               /* Compiled op trees are readonly, and can thus be
+                  shared without duplication. */
                d->data[i] = (void*)OpREFCNT_inc((OP*)r->data->data[i]);
                break;
            case 'n':
@@ -9089,6 +9090,11 @@ Perl_sv_dup(pTHX_ SV *sstr, clone_params* param)
        CvROOT(dstr)    = OpREFCNT_inc(CvROOT(sstr));
        CvXSUB(dstr)    = CvXSUB(sstr);
        CvXSUBANY(dstr) = CvXSUBANY(sstr);
+       if (CvCONST(sstr)) {
+           CvXSUBANY(dstr).any_ptr = GvUNIQUE(CvGV(sstr)) ?
+                SvREFCNT_inc(CvXSUBANY(sstr).any_ptr) :
+                sv_dup_inc(CvXSUBANY(sstr).any_ptr, param);
+       }
        CvGV(dstr)      = gv_dup(CvGV(sstr), param);
        if (param->flags & CLONEf_COPY_STACKS) {
          CvDEPTH(dstr) = CvDEPTH(sstr);
@@ -9548,6 +9554,8 @@ Create and return a new interpreter by cloning the current one.
 */
 
 /* XXX the above needs expanding by someone who actually understands it ! */
+EXTERN_C PerlInterpreter *
+perl_clone_host(PerlInterpreter* proto_perl, UV flags);
 
 PerlInterpreter *
 perl_clone(PerlInterpreter *proto_perl, UV flags)
@@ -9776,6 +9784,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_e_script                = sv_dup_inc(proto_perl->Ie_script, param);
     PL_perldb          = proto_perl->Iperldb;
     PL_perl_destruct_level = proto_perl->Iperl_destruct_level;
+    PL_exit_flags       = proto_perl->Iexit_flags;
 
     /* magical thingies */
     /* XXX time(&PL_basetime) when asked for? */
@@ -10250,6 +10259,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_reg_re          = (regexp*)NULL;
     PL_reg_ganch       = Nullch;
     PL_reg_sv          = Nullsv;
+    PL_reg_sv_utf8     = FALSE;
     PL_reg_magic       = (MAGIC*)NULL;
     PL_reg_oldpos      = 0;
     PL_reg_oldcurpm    = (PMOP*)NULL;