X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=193c9fb0f5d1a2e91757fbd4f903635c9b1ba207;hb=f9dc862fc43278b696e6cacef943fbe534e5baba;hp=b1da4a8ee51b6dd5a21f38f1f05508030f30f703;hpb=758a08c30aea50da395b8956fd114bbcb2c519a0;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/sv.c b/sv.c
index b1da4a8..193c9fb 100644
--- a/sv.c
+++ b/sv.c
@@ -216,6 +216,8 @@ S_del_sv(pTHX_ SV *p)
 
 
 /*
+=head1 SV Manipulation Functions
+
 =for apidoc sv_add_arena
 
 Given a chunk of memory, link it to the head of the list of arenas,
@@ -1422,8 +1424,8 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
 	SvPVX(sv)	= 0;
 	HvFILL(sv)	= 0;
 	HvMAX(sv)	= 0;
-	HvKEYS(sv)	= 0;
-	SvNVX(sv)	= 0.0;
+	HvTOTALKEYS(sv)	= 0;
+	HvPLACEHOLDERS(sv) = 0;
 	SvMAGIC(sv)	= magic;
 	SvSTASH(sv)	= stash;
 	HvRITER(sv)	= 0;
@@ -1941,7 +1943,7 @@ Perl_looks_like_number(pTHX_ SV *sv)
 STATIC int
 S_sv_2iuv_non_preserve(pTHX_ register SV *sv, I32 numtype)
 {
-    DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_2iuv_non '%s', IV=0x%"UVxf" NV=%g inttype=%"UVXf"\n", SvPVX(sv), SvIVX(sv), SvNVX(sv), (UV)numtype));
+    DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_2iuv_non '%s', IV=0x%"UVxf" NV=%"NVgf" inttype=%"UVXf"\n", SvPVX(sv), SvIVX(sv), SvNVX(sv), (UV)numtype));
     if (SvNVX(sv) < (NV)IV_MIN) {
 	(void)SvIOKp_on(sv);
 	(void)SvNOK_on(sv);
@@ -2195,7 +2197,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
 	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2iv(%" PERL_PRIgldbl ")\n",
 				  PTR2UV(sv), SvNVX(sv)));
 #else
-	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2iv(%g)\n",
+	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2iv(%"NVgf")\n",
 				  PTR2UV(sv), SvNVX(sv)));
 #endif
 
@@ -2251,7 +2253,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
                        this NV is in the preserved range, therefore: */
                     if (!(U_V(SvNVX(sv) > 0 ? SvNVX(sv) : -SvNVX(sv))
                           < (UV)IV_MAX)) {
-                        Perl_croak(aTHX_ "sv_2iv assumed (U_V(fabs(SvNVX(sv))) < (UV)IV_MAX) but SvNVX(sv)=%g U_V is 0x%"UVxf", IV_MAX is 0x%"UVxf"\n", SvNVX(sv), U_V(SvNVX(sv)), (UV)IV_MAX);
+                        Perl_croak(aTHX_ "sv_2iv assumed (U_V(fabs(SvNVX(sv))) < (UV)IV_MAX) but SvNVX(sv)=%"NVgf" U_V is 0x%"UVxf", IV_MAX is 0x%"UVxf"\n", SvNVX(sv), U_V(SvNVX(sv)), (UV)IV_MAX);
                     }
                 } else {
                     /* IN_UV NOT_INT
@@ -2483,7 +2485,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
             DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2uv(%" PERL_PRIgldbl ")\n",
                                   PTR2UV(sv), SvNVX(sv)));
 #else
-            DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2uv(%g)\n",
+            DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2uv(%"NVgf")\n",
                                   PTR2UV(sv), SvNVX(sv)));
 #endif
 
@@ -2538,7 +2540,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
                        this NV is in the preserved range, therefore: */
                     if (!(U_V(SvNVX(sv) > 0 ? SvNVX(sv) : -SvNVX(sv))
                           < (UV)IV_MAX)) {
-                        Perl_croak(aTHX_ "sv_2uv assumed (U_V(fabs(SvNVX(sv))) < (UV)IV_MAX) but SvNVX(sv)=%g U_V is 0x%"UVxf", IV_MAX is 0x%"UVxf"\n", SvNVX(sv), U_V(SvNVX(sv)), (UV)IV_MAX);
+                        Perl_croak(aTHX_ "sv_2uv assumed (U_V(fabs(SvNVX(sv))) < (UV)IV_MAX) but SvNVX(sv)=%"NVgf" U_V is 0x%"UVxf", IV_MAX is 0x%"UVxf"\n", SvNVX(sv), U_V(SvNVX(sv)), (UV)IV_MAX);
                     }
                 } else
                     sv_2iuv_non_preserve (sv, numtype);
@@ -2634,7 +2636,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 #else
 	DEBUG_c({
 	    STORE_NUMERIC_LOCAL_SET_STANDARD();
-	    PerlIO_printf(Perl_debug_log, "0x%"UVxf" num(%g)\n",
+	    PerlIO_printf(Perl_debug_log, "0x%"UVxf" num(%"NVgf")\n",
 			  PTR2UV(sv), SvNVX(sv));
 	    RESTORE_NUMERIC_LOCAL();
 	});
@@ -2763,7 +2765,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 #else
     DEBUG_c({
 	STORE_NUMERIC_LOCAL_SET_STANDARD();
-	PerlIO_printf(Perl_debug_log, "0x%"UVxf" 1nv(%g)\n",
+	PerlIO_printf(Perl_debug_log, "0x%"UVxf" 1nv(%"NVgf")\n",
 		      PTR2UV(sv), SvNVX(sv));
 	RESTORE_NUMERIC_LOCAL();
     });
@@ -3235,7 +3237,7 @@ Perl_sv_2bool(pTHX_ register SV *sv)
     if (SvROK(sv)) {
 	SV* tmpsv;
         if (SvAMAGIC(sv) && (tmpsv=AMG_CALLun(sv,bool_)) &&
-                (SvTYPE(tmpsv) != SVt_RV || (SvRV(tmpsv) != SvRV(sv))))
+                (!SvROK(tmpsv) || (SvRV(tmpsv) != SvRV(sv))))
 	    return SvTRUE(tmpsv);
       return SvRV(sv) != 0;
     }
@@ -4455,10 +4457,10 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam
     mg->mg_moremagic = SvMAGIC(sv);
     SvMAGIC(sv) = mg;
 
-    /* Some magic contains a reference loop, where the sv and object refer to
-       each other.  To avoid a reference loop that would prevent such objects
-       being freed, we look for such loops and if we find one we avoid
-       incrementing the object refcount. */
+    /* Some magic sontains a reference loop, where the sv and object refer to
+       each other.  To prevent a reference loop that would prevent such
+       objects being freed, we look for such loops and if we find one we
+       avoid incrementing the object refcount. */
     if (!obj || obj == sv ||
 	how == PERL_MAGIC_arylen ||
 	how == PERL_MAGIC_qr ||
@@ -5666,7 +5668,7 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
     DEBUG_P(PerlIO_printf(Perl_debug_log,
 	"Screamer: entering, ptr=%"UVuf", cnt=%ld\n",PTR2UV(ptr),(long)cnt));
     DEBUG_P(PerlIO_printf(Perl_debug_log,
-	"Screamer: entering: FILE * thinks ptr=%"UVuf", cnt=%ld, base=%"UVuf"\n",
+	"Screamer: entering: PerlIO * thinks ptr=%"UVuf", cnt=%ld, base=%"UVuf"\n",
 	       PTR2UV(PerlIO_get_ptr(fp)), (long)PerlIO_get_cnt(fp),
 	       PTR2UV(PerlIO_has_base(fp) ? PerlIO_get_base(fp) : 0)));
     for (;;) {
@@ -5700,19 +5702,23 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
 	DEBUG_P(PerlIO_printf(Perl_debug_log,
 			      "Screamer: going to getc, ptr=%"UVuf", cnt=%ld\n",
 			      PTR2UV(ptr),(long)cnt));
-	PerlIO_set_ptrcnt(fp, ptr, cnt); /* deregisterize cnt and ptr */
+	PerlIO_set_ptrcnt(fp, (STDCHAR*)ptr, cnt); /* deregisterize cnt and ptr */
+#if 0
 	DEBUG_P(PerlIO_printf(Perl_debug_log,
 	    "Screamer: pre: FILE * thinks ptr=%"UVuf", cnt=%ld, base=%"UVuf"\n",
 	    PTR2UV(PerlIO_get_ptr(fp)), (long)PerlIO_get_cnt(fp),
 	    PTR2UV(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)));
+#endif
 	/* This used to call 'filbuf' in stdio form, but as that behaves like
 	   getc when cnt <= 0 we use PerlIO_getc here to avoid introducing
 	   another abstraction.  */
 	i   = PerlIO_getc(fp);		/* get more characters */
+#if 0
 	DEBUG_P(PerlIO_printf(Perl_debug_log,
 	    "Screamer: post: FILE * thinks ptr=%"UVuf", cnt=%ld, base=%"UVuf"\n",
 	    PTR2UV(PerlIO_get_ptr(fp)), (long)PerlIO_get_cnt(fp),
 	    PTR2UV(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)));
+#endif
 	cnt = PerlIO_get_cnt(fp);
 	ptr = (STDCHAR*)PerlIO_get_ptr(fp);	/* reregisterize cnt and ptr */
 	DEBUG_P(PerlIO_printf(Perl_debug_log,
@@ -5741,7 +5747,7 @@ thats_really_all_folks:
 	cnt += shortbuffered;
 	DEBUG_P(PerlIO_printf(Perl_debug_log,
 	    "Screamer: quitting, ptr=%"UVuf", cnt=%ld\n",PTR2UV(ptr),(long)cnt));
-    PerlIO_set_ptrcnt(fp, ptr, cnt);	/* put these back or we're in trouble */
+    PerlIO_set_ptrcnt(fp, (STDCHAR*)ptr, cnt);	/* put these back or we're in trouble */
     DEBUG_P(PerlIO_printf(Perl_debug_log,
 	"Screamer: end: FILE * thinks ptr=%"UVuf", cnt=%ld, base=%"UVuf"\n",
 	PTR2UV(PerlIO_get_ptr(fp)), (long)PerlIO_get_cnt(fp),
@@ -5846,6 +5852,8 @@ Perl_sv_inc(pTHX_ register SV *sv)
     if (SvGMAGICAL(sv))
 	mg_get(sv);
     if (SvTHINKFIRST(sv)) {
+	if (SvREADONLY(sv) && SvFAKE(sv))
+	    sv_force_normal(sv);
 	if (SvREADONLY(sv)) {
 	    if (PL_curcop != &PL_compiling)
 		Perl_croak(aTHX_ PL_no_modify);
@@ -5934,7 +5942,7 @@ Perl_sv_inc(pTHX_ register SV *sv)
 	    DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_inc punt failed to convert '%s' to IOK or NOKp, UV=0x%"UVxf" NV=%"PERL_PRIgldbl"\n",
 				  SvPVX(sv), SvIVX(sv), SvNVX(sv)));
 #else
-	    DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_inc punt failed to convert '%s' to IOK or NOKp, UV=0x%"UVxf" NV=%g\n",
+	    DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_inc punt failed to convert '%s' to IOK or NOKp, UV=0x%"UVxf" NV=%"NVgf"\n",
 				  SvPVX(sv), SvIVX(sv), SvNVX(sv)));
 #endif
 	}
@@ -6000,6 +6008,8 @@ Perl_sv_dec(pTHX_ register SV *sv)
     if (SvGMAGICAL(sv))
 	mg_get(sv);
     if (SvTHINKFIRST(sv)) {
+	if (SvREADONLY(sv) && SvFAKE(sv))
+	    sv_force_normal(sv);
 	if (SvREADONLY(sv)) {
 	    if (PL_curcop != &PL_compiling)
 		Perl_croak(aTHX_ PL_no_modify);
@@ -6080,7 +6090,7 @@ Perl_sv_dec(pTHX_ register SV *sv)
 	    DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_dec punt failed to convert '%s' to IOK or NOKp, UV=0x%"UVxf" NV=%"PERL_PRIgldbl"\n",
 				  SvPVX(sv), SvIVX(sv), SvNVX(sv)));
 #else
-	    DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_dec punt failed to convert '%s' to IOK or NOKp, UV=0x%"UVxf" NV=%g\n",
+	    DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_dec punt failed to convert '%s' to IOK or NOKp, UV=0x%"UVxf" NV=%"NVgf"\n",
 				  SvPVX(sv), SvIVX(sv), SvNVX(sv)));
 #endif
 	}
@@ -9672,6 +9682,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_savestack = 0;
     PL_retstack = 0;
     PL_sig_pending = 0;
+    Zero(&PL_debug_pad, 1, struct perl_debug_pad);
 #  else	/* !DEBUGGING */
     Zero(my_perl, 1, PerlInterpreter);
 #  endif	/* DEBUGGING */
@@ -9701,6 +9712,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_savestack = 0;
     PL_retstack = 0;
     PL_sig_pending = 0;
+    Zero(&PL_debug_pad, 1, struct perl_debug_pad);
 #    else	/* !DEBUGGING */
     Zero(my_perl, 1, PerlInterpreter);
 #    endif	/* DEBUGGING */
@@ -10377,6 +10389,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 #endif /* USE_ITHREADS */
 
 /*
+=head1 Unicode Support
+
 =for apidoc sv_recode_to_utf8
 
 The encoding is assumed to be an Encode object, on entry the PV