[no reason given] is not good.

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

diff --git a/sv.c b/sv.c
index 3ab9f05..5885b8e 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1756,61 +1756,70 @@ Perl_sv_setnv_mg(pTHX_ register SV *sv, NV num)
 STATIC void
 S_not_a_number(pTHX_ SV *sv)
 {
-    char tmpbuf[64];
-    char *d = tmpbuf;
-    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;
-       if (ch & 128 && !isPRINT_LC(ch)) {
-           *d++ = 'M';
-           *d++ = '-';
-           ch &= 127;
-       }
-       if (ch == '\n') {
-           *d++ = '\\';
-           *d++ = 'n';
-       }
-       else if (ch == '\r') {
-           *d++ = '\\';
-           *d++ = 'r';
-       }
-       else if (ch == '\f') {
-           *d++ = '\\';
-           *d++ = 'f';
-       }
-       else if (ch == '\\') {
-           *d++ = '\\';
-           *d++ = '\\';
-       }
-       else if (ch == '\0') {
-           *d++ = '\\';
-           *d++ = '0';
-       }
-       else if (isPRINT_LC(ch))
-           *d++ = ch;
-       else {
-           *d++ = '^';
-           *d++ = toCTRL(ch);
-       }
-    }
-    if (s < end) {
-       *d++ = '.';
-       *d++ = '.';
-       *d++ = '.';
+     SV *dsv;
+     char tmpbuf[64];
+     char *pv;
+
+     if (DO_UTF8(sv)) {
+          dsv = sv_2mortal(newSVpv("", 0));
+          pv = sv_uni_display(dsv, sv, 10, 0);
+     } else {
+         char *d = tmpbuf;
+         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;
+              if (ch & 128 && !isPRINT_LC(ch)) {
+                   *d++ = 'M';
+                   *d++ = '-';
+                   ch &= 127;
+              }
+              if (ch == '\n') {
+                   *d++ = '\\';
+                   *d++ = 'n';
+              }
+              else if (ch == '\r') {
+                   *d++ = '\\';
+                   *d++ = 'r';
+              }
+              else if (ch == '\f') {
+                   *d++ = '\\';
+                   *d++ = 'f';
+              }
+              else if (ch == '\\') {
+                   *d++ = '\\';
+                   *d++ = '\\';
+              }
+              else if (ch == '\0') {
+                   *d++ = '\\';
+                   *d++ = '0';
+              }
+              else if (isPRINT_LC(ch))
+                   *d++ = ch;
+              else {
+                   *d++ = '^';
+                   *d++ = toCTRL(ch);
+              }
+         }
+         if (s < end) {
+              *d++ = '.';
+              *d++ = '.';
+              *d++ = '.';
+         }
+         *d = '\0';
+         pv = tmpbuf;
     }
-    *d = '\0';
 
     if (PL_op)
        Perl_warner(aTHX_ WARN_NUMERIC,
-                   "Argument \"%s\" isn't numeric in %s", tmpbuf,
-                       OP_DESC(PL_op));
+                   "Argument \"%s\" isn't numeric in %s", pv,
+                   OP_DESC(PL_op));
     else
        Perl_warner(aTHX_ WARN_NUMERIC,
-                   "Argument \"%s\" isn't numeric", tmpbuf);
+                   "Argument \"%s\" isn't numeric", pv);
 }
 
 /*
@@ -7205,6 +7214,12 @@ Perl_sv_bless(pTHX_ SV *sv, HV *stash)
     else
        SvAMAGIC_off(sv);
 
+    if(SvSMAGICAL(tmpRef))
+        if(mg_find(tmpRef, PERL_MAGIC_ext) || mg_find(tmpRef, PERL_MAGIC_uvar))
+            mg_set(tmpRef);
+
+
+ 
     return sv;
 }
 
@@ -9768,8 +9783,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     param->stashes      = newAV();  /* Setup array of objects to call clone on */
 
 #ifdef PERLIO_LAYERS
-    /* Clone PerlIO table as soon as we can handle general xx_dup() */
-    PerlIO_clone(aTHX_ proto_perl->Iperlio, param);
+    /* Clone PerlIO tables as soon as we can handle general xx_dup() */
+    PerlIO_clone(aTHX_ proto_perl, param);
 #endif
 
     PL_envgv           = gv_dup(proto_perl->Ienvgv, param);