X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=fcabd8e5c4aac3047dc621c56ee79e2dd519b635;hb=3d3d4f39342abc069c6470bf0947f2d00d3ead72;hp=553267a853497ce817778e76ab413daa1d4e8f4f;hpb=1768d7ebbd79c945a432bd18f2f9bed6d1a79356;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/sv.c b/sv.c
index 553267a..fcabd8e 100644
--- a/sv.c
+++ b/sv.c
@@ -295,6 +295,8 @@ S_visit(pTHX_ SVFUNC_t f)
     return visited;
 }
 
+#ifdef DEBUGGING
+
 /* called by sv_report_used() for each live SV */
 
 static void
@@ -305,6 +307,7 @@ do_report_used(pTHX_ SV *sv)
 	sv_dump(sv);
     }
 }
+#endif
 
 /*
 =for apidoc sv_report_used
@@ -317,7 +320,9 @@ Dump the contents of all SVs not yet freed. (Debugging aid).
 void
 Perl_sv_report_used(pTHX)
 {
+#ifdef DEBUGGING
     visit(do_report_used);
+#endif
 }
 
 /* called by sv_clean_objs() for each live SV */
@@ -1768,7 +1773,7 @@ S_not_a_number(pTHX_ SV *sv)
 	  char *limit = tmpbuf + sizeof(tmpbuf) - 8;
 	  /* each *s can expand to 4 chars + "...\0",
 	     i.e. need room for 8 chars */
-	  
+	
 	  char *s, *end;
 	  for (s = SvPVX(sv), end = s + SvCUR(sv); s < end && d < limit; s++) {
 	       int ch = *s & 0xFF;
@@ -2163,7 +2168,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
 		    SvIVX(sv) = -(IV)value;
 		} else {
 		    /* Too negative for an IV.  This is a double upgrade, but
-		       I'm assuming it will be be rare.  */
+		       I'm assuming it will be rare.  */
 		    if (SvTYPE(sv) < SVt_PVNV)
 			sv_upgrade(sv, SVt_PVNV);
 		    SvNOK_on(sv);
@@ -2454,7 +2459,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 		    SvIVX(sv) = -(IV)value;
 		} else {
 		    /* Too negative for an IV.  This is a double upgrade, but
-		       I'm assuming it will be be rare.  */
+		       I'm assuming it will be rare.  */
 		    if (SvTYPE(sv) < SVt_PVNV)
 			sv_upgrade(sv, SVt_PVNV);
 		    SvNOK_on(sv);
@@ -3004,8 +3009,15 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 		default:	s = "UNKNOWN";			break;
 		}
 		tsv = NEWSV(0,0);
-		if (SvOBJECT(sv))
-		    Perl_sv_setpvf(aTHX_ tsv, "%s=%s", HvNAME(SvSTASH(sv)), s);
+		if (SvOBJECT(sv)) {
+                    HV *svs = SvSTASH(sv);
+		    Perl_sv_setpvf(
+                        aTHX_ tsv, "%s=%s",
+                        /* [20011101.072] This bandaid for C<package;>
+                           should eventually be removed. AMS 20011103 */
+                        (svs ? HvNAME(svs) : "<none>"), s
+                    );
+                }
 		else
 		    sv_setpv(tsv, s);
 		Perl_sv_catpvf(aTHX_ tsv, "(0x%"UVxf")", PTR2UV(sv));
@@ -3319,7 +3331,7 @@ Perl_sv_utf8_upgrade_flags(pTHX_ register SV *sv, I32 flags)
 	 }
 	 if (hibit) {
 	      STRLEN len;
-	      
+	
 	      len = SvCUR(sv) + 1; /* Plus the \0 */
 	      SvPVX(sv) = (char*)bytes_to_utf8((U8*)s, &len);
 	      SvCUR(sv) = len - 1;
@@ -5834,6 +5846,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);
@@ -5861,7 +5875,7 @@ Perl_sv_inc(pTHX_ register SV *sv)
 #endif
 	if (SvIsUV(sv)) {
 	    if (SvUVX(sv) == UV_MAX)
-		sv_setnv(sv, (NV)UV_MAX + 1.0);
+		sv_setnv(sv, UV_MAX_P1);
 	    else
 		(void)SvIOK_only_UV(sv);
 		++SvUVX(sv);
@@ -5893,7 +5907,7 @@ Perl_sv_inc(pTHX_ register SV *sv)
     while (isDIGIT(*d)) d++;
     if (*d) {
 #ifdef PERL_PRESERVE_IVUV
-	/* Got to punt this an an integer if needs be, but we don't issue
+	/* 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
 	   the conversion if possible, and silently.  */
 	int numtype = grok_number(SvPVX(sv), SvCUR(sv), NULL);
@@ -5988,6 +6002,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);
@@ -6942,8 +6958,12 @@ Returns a string describing what the SV is a reference to.
 char *
 Perl_sv_reftype(pTHX_ SV *sv, int ob)
 {
-    if (ob && SvOBJECT(sv))
-	return HvNAME(SvSTASH(sv));
+    if (ob && SvOBJECT(sv)) {
+        HV *svs = SvSTASH(sv);
+        /* [20011101.072] This bandaid for C<package;> should eventually
+           be removed. AMS 20011103 */
+        return (svs ? HvNAME(svs) : "<none>");
+    }
     else {
 	switch (SvTYPE(sv)) {
 	case SVt_NULL:
@@ -7223,7 +7243,7 @@ Perl_sv_bless(pTHX_ SV *sv, HV *stash)
             mg_set(tmpRef);
 
 
- 
+
     return sv;
 }
 
@@ -8511,7 +8531,7 @@ Perl_fp_dup(pTHX_ PerlIO *fp, char type, CLONE_PARAMS *param)
 	return ret;
 
     /* create anew and remember what it is */
-    ret = PerlIO_fdupopen(aTHX_ fp, param);
+    ret = PerlIO_fdupopen(aTHX_ fp, param, PERLIO_DUP_CLONE);
     ptr_table_store(PL_ptr_table, fp, ret);
     return ret;
 }
@@ -10096,6 +10116,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_utf8_toupper	= sv_dup_inc(proto_perl->Iutf8_toupper, param);
     PL_utf8_totitle	= sv_dup_inc(proto_perl->Iutf8_totitle, param);
     PL_utf8_tolower	= sv_dup_inc(proto_perl->Iutf8_tolower, param);
+    PL_utf8_tofold	= sv_dup_inc(proto_perl->Iutf8_tofold, param);
 
     /* swatch cache */
     PL_last_swash_hv	= Nullhv;	/* reinits on demand */
@@ -10378,7 +10399,7 @@ The PV of the sv is returned.
 char *
 Perl_sv_recode_to_utf8(pTHX_ SV *sv, SV *encoding)
 {
-     if (SvPOK(sv) && !SvUTF8(sv) && SvROK(encoding)) {
+     if (SvPOK(sv) && !DO_UTF8(sv) && SvROK(encoding)) {
 	  SV *uni;
 	  STRLEN len;
 	  char *s;
@@ -10395,7 +10416,7 @@ Perl_sv_recode_to_utf8(pTHX_ SV *sv, SV *encoding)
 	  SPAGAIN;
 	  uni = POPs;
 	  PUTBACK;
-	  s = SvPVutf8(uni, len);
+	  s = SvPV(uni, len);
 	  if (s != SvPVX(sv)) {
 	       SvGROW(sv, len);
 	       Move(s, SvPVX(sv), len, char);