X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=997a3a8b261d1f8d8cabfabbf3eeef7fa0d96714;hb=29bdacb8f1686adf0d6e73a4e2fd7fb9becf6eab;hp=a447517b9625c565fd6afb44a6c9681471067c46;hpb=9f4817dbf9f375fea5253c12557f39e3774b891c;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/sv.c b/sv.c
index a447517..997a3a8 100644
--- a/sv.c
+++ b/sv.c
@@ -2163,7 +2163,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 +2454,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 +3004,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));
@@ -3303,7 +3310,7 @@ Perl_sv_utf8_upgrade_flags(pTHX_ register SV *sv, I32 flags)
     }
 
     if (PL_encoding)
-        Perl_sv_recode_to_utf8(aTHX_ sv);
+        Perl_sv_recode_to_utf8(aTHX_ sv, PL_encoding);
     else { /* Assume Latin-1/EBCDIC */
 	 /* This function could be much more efficient if we
 	  * had a FLAG in SVs to signal if there are any hibit
@@ -5861,7 +5868,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 +5900,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);
@@ -6942,8 +6949,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:
@@ -10096,6 +10107,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 */
@@ -10362,43 +10374,49 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 /*
 =for apidoc sv_recode_to_utf8
 
-If PL_encoding is set you can call this to recode the pv of the sv.
-The PL_encoding is assumed to be an Encode object, on entry the pv is assumed
-to be octets in that encoding, and the sv will be converted into Unicode
-(and UTF-8).
+The encoding is assumed to be an Encode object, on entry the PV
+of the sv is assumed to be octets in that encoding, and the sv
+will be converted into Unicode (and UTF-8).
 
-If PL_encoding is not an Encode object, things will go boom.
+If the sv already is UTF-8 (or if it is not POK), or if the encoding
+is not a reference, nothing is done to the sv.  If the encoding is not
+an C<Encode::XS> Encoding object, bad things will happen.
+(See F<lib/encoding.pm> and L<Encode>).
 
-=cut
-*/
+The PV of the sv is returned.
 
-void
-Perl_sv_recode_to_utf8(pTHX_ SV *sv)
-{
-     SV *uni;
-     STRLEN len;
-     char *s;
-     dSP;
-     ENTER;
-     SAVETMPS;
-     PUSHMARK(sp);
-     EXTEND(SP, 3);
-     XPUSHs(PL_encoding);
-     XPUSHs(sv);
-     XPUSHs(&PL_sv_yes);
-     PUTBACK;
-     call_method("decode", G_SCALAR);
-     SPAGAIN;
-     uni = POPs;
-     PUTBACK;
-     s = SvPVutf8(uni, len);
-     if (s != SvPVX(sv)) {
-	  SvGROW(sv, len);
-	  Move(s, SvPVX(sv), len, char);
-	  SvCUR_set(sv, len);
+=cut */
+
+char *
+Perl_sv_recode_to_utf8(pTHX_ SV *sv, SV *encoding)
+{
+     if (SvPOK(sv) && !DO_UTF8(sv) && SvROK(encoding)) {
+	  SV *uni;
+	  STRLEN len;
+	  char *s;
+	  dSP;
+	  ENTER;
+	  SAVETMPS;
+	  PUSHMARK(sp);
+	  EXTEND(SP, 3);
+	  XPUSHs(encoding);
+	  XPUSHs(sv);
+	  XPUSHs(&PL_sv_yes);
+	  PUTBACK;
+	  call_method("decode", G_SCALAR);
+	  SPAGAIN;
+	  uni = POPs;
+	  PUTBACK;
+	  s = SvPV(uni, len);
+	  if (s != SvPVX(sv)) {
+	       SvGROW(sv, len);
+	       Move(s, SvPVX(sv), len, char);
+	       SvCUR_set(sv, len);
+	  }
+	  FREETMPS;
+	  LEAVE;
+	  SvUTF8_on(sv);
      }
-     FREETMPS;
-     LEAVE;
-     SvUTF8_on(sv);
+     return SvPVX(sv);
 }