Re[2]: [ID 20020227.016] Fix perldata manpage?

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

diff --git a/sv.c b/sv.c
index 89633b5..27150d6 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1,6 +1,6 @@
 /*    sv.c
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -1584,6 +1584,9 @@ Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen)
                SvREADONLY_off(sv);
            }
            New(703, s, newlen, char);
+           if (SvPVX(sv) && SvCUR(sv)) {
+               Move(SvPVX(sv), s, SvCUR(sv), char);
+           }
        }
        SvPV_set(sv, s);
         SvLEN_set(sv, newlen);
@@ -3145,6 +3148,45 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 }
 
 /*
+=for apidoc sv_copypv
+
+Copies a stringified representation of the source SV into the
+destination SV.  Automatically performs any necessary mg_get and
+coercion of numeric values into strings.  Guaranteed to preserve 
+UTF-8 flag even from overloaded objects.  Similar in nature to
+sv_2pv[_flags] but operates directly on an SV instead of just the 
+string.  Mostly uses sv_2pv_flags to do its work, except when that 
+would lose the UTF-8'ness of the PV.
+
+=cut
+*/
+
+void
+Perl_sv_copypv(pTHX_ SV *dsv, register SV *ssv)
+{
+    SV *tmpsv = sv_newmortal();
+
+    if ( SvTHINKFIRST(ssv) && SvROK(ssv) && SvAMAGIC(ssv) ) {
+       tmpsv = AMG_CALLun(ssv,string);
+       if (SvTYPE(tmpsv) != SVt_RV || (SvRV(tmpsv) != SvRV(ssv))) {
+           SvSetSV(dsv,tmpsv);
+           return;
+       }
+    }
+    {
+       STRLEN len;
+       char *s;
+       s = SvPV(ssv,len);
+       sv_setpvn(tmpsv,s,len);
+       if (SvUTF8(ssv))
+           SvUTF8_on(tmpsv);
+       else
+           SvUTF8_off(tmpsv);
+       SvSetSV(dsv,tmpsv);
+    }
+}
+
+/*
 =for apidoc sv_2pvbyte_nolen
 
 Return a pointer to the byte-encoded representation of the SV.
@@ -3372,28 +3414,6 @@ Perl_sv_utf8_downgrade(pTHX_ register SV* sv, bool fail_ok)
            if (!utf8_to_bytes(s, &len)) {
                if (fail_ok)
                    return FALSE;
-#ifdef USE_BYTES_DOWNGRADES
-               else if (IN_BYTES) {
-                   U8 *d = s;
-                   U8 *e = (U8 *) SvEND(sv);
-                   int first = 1;
-                   while (s < e) {
-                       UV ch = utf8n_to_uvchr(s,(e-s),&len,0);
-                       if (first && ch > 255) {
-                           if (PL_op)
-                               Perl_warner(aTHX_ WARN_UTF8, "Wide character in byte %s",
-                                          OP_DESC(PL_op);
-                           else
-                               Perl_warner(aTHX_ WARN_UTF8, "Wide character in byte");
-                           first = 0;
-                       }
-                       *d++ = ch;
-                       s += len;
-                   }
-                   *d = '\0';
-                   len = (d - (U8 *) SvPVX(sv));
-               }
-#endif
                else {
                    if (PL_op)
                        Perl_croak(aTHX_ "Wide character in %s",
@@ -3771,8 +3791,9 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
                                        GvENAME((GV*)dstr));
                                }
                            }
-                           cv_ckproto(cv, (GV*)dstr,
-                                      SvPOK(sref) ? SvPVX(sref) : Nullch);
+                           if (!intro)
+                               cv_ckproto(cv, (GV*)dstr,
+                                       SvPOK(sref) ? SvPVX(sref) : Nullch);
                        }
                        GvCV(dstr) = (CV*)sref;
                        GvCVGEN(dstr) = 0; /* Switch off cacheness. */