Integrate mainline some more

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

diff --git a/sv.c b/sv.c
index 553267a..fcabd8e 100644 (file)
--- 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);