[no reason given] is not good.

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

diff --git a/sv.c b/sv.c
index 35fe436..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);
-       }
+     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;
     }
-    if (s < end) {
-       *d++ = '.';
-       *d++ = '.';
-       *d++ = '.';
-    }
-    *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;
 }
 
@@ -8382,7 +8397,7 @@ ptr_table_* functions.
    regcomp.c. AMS 20010712 */
 
 REGEXP *
-Perl_re_dup(pTHX_ REGEXP *r, clone_params *param)
+Perl_re_dup(pTHX_ REGEXP *r, CLONE_PARAMS *param)
 {
     REGEXP *ret;
     int i, len, npar;
@@ -8480,7 +8495,7 @@ Perl_re_dup(pTHX_ REGEXP *r, clone_params *param)
 /* duplicate a file handle */
 
 PerlIO *
-Perl_fp_dup(pTHX_ PerlIO *fp, char type,clone_params *param)
+Perl_fp_dup(pTHX_ PerlIO *fp, char type, CLONE_PARAMS *param)
 {
     PerlIO *ret;
     if (!fp)
@@ -8511,7 +8526,7 @@ Perl_dirp_dup(pTHX_ DIR *dp)
 /* duplicate a typeglob */
 
 GP *
-Perl_gp_dup(pTHX_ GP *gp, clone_params* param)
+Perl_gp_dup(pTHX_ GP *gp, CLONE_PARAMS* param)
 {
     GP *ret;
     if (!gp)
@@ -8544,7 +8559,7 @@ Perl_gp_dup(pTHX_ GP *gp, clone_params* param)
 /* duplicate a chain of magic */
 
 MAGIC *
-Perl_mg_dup(pTHX_ MAGIC *mg, clone_params* param)
+Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS* param)
 {
     MAGIC *mgprev = (MAGIC*)NULL;
     MAGIC *mgret;
@@ -8815,7 +8830,7 @@ S_gv_share(pTHX_ SV *sstr)
 /* duplicate an SV of any type (including AV, HV etc) */
 
 SV *
-Perl_sv_dup(pTHX_ SV *sstr, clone_params* param)
+Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
 {
     SV *dstr;
 
@@ -9010,11 +9025,11 @@ Perl_sv_dup(pTHX_ SV *sstr, clone_params* param)
            SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
        else
            SvPVX(dstr) = SvPVX(sstr);          /* XXX shared string/random ptr? */
-       IoIFP(dstr)     = fp_dup(IoIFP(sstr), IoTYPE(sstr));
+       IoIFP(dstr)     = fp_dup(IoIFP(sstr), IoTYPE(sstr), param);
        if (IoOFP(sstr) == IoIFP(sstr))
            IoOFP(dstr) = IoIFP(dstr);
        else
-           IoOFP(dstr) = fp_dup(IoOFP(sstr), IoTYPE(sstr));
+           IoOFP(dstr) = fp_dup(IoOFP(sstr), IoTYPE(sstr), param);
        /* PL_rsfp_filters entries have fake IoDIRP() */
        if (IoDIRP(sstr) && !(IoFLAGS(sstr) & IOf_FAKE_DIRP))
            IoDIRP(dstr)        = dirp_dup(IoDIRP(sstr));
@@ -9167,7 +9182,7 @@ Perl_sv_dup(pTHX_ SV *sstr, clone_params* param)
 /* duplicate a context */
 
 PERL_CONTEXT *
-Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, clone_params* param)
+Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
 {
     PERL_CONTEXT *ncxs;
 
@@ -9255,7 +9270,7 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, clone_params* param)
 /* duplicate a stack info structure */
 
 PERL_SI *
-Perl_si_dup(pTHX_ PERL_SI *si, clone_params* param)
+Perl_si_dup(pTHX_ PERL_SI *si, CLONE_PARAMS* param)
 {
     PERL_SI *nsi;
 
@@ -9330,7 +9345,7 @@ Perl_any_dup(pTHX_ void *v, PerlInterpreter *proto_perl)
 /* duplicate the save stack */
 
 ANY *
-Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, clone_params* param)
+Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
 {
     ANY *ss    = proto_perl->Tsavestack;
     I32 ix     = proto_perl->Tsavestack_ix;
@@ -9625,7 +9640,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
      * their pointers copied. */
 
     IV i;
-    clone_params* param = (clone_params*) malloc(sizeof(clone_params));
+    CLONE_PARAMS* param = (CLONE_PARAMS*) malloc(sizeof(CLONE_PARAMS));
 
     PerlInterpreter *my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
     PERL_SET_THX(my_perl);
@@ -9653,7 +9668,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_Proc            = ipP;
 #else          /* !PERL_IMPLICIT_SYS */
     IV i;
-    clone_params* param = (clone_params*) malloc(sizeof(clone_params));
+    CLONE_PARAMS* param = (CLONE_PARAMS*) malloc(sizeof(CLONE_PARAMS));
     PerlInterpreter *my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
     PERL_SET_THX(my_perl);
 
@@ -9765,9 +9780,12 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
        PL_origargv[i]  = SAVEPV(proto_perl->Iorigargv[i]);
     }
 
-
     param->stashes      = newAV();  /* Setup array of objects to call clone on */
 
+#ifdef PERLIO_LAYERS
+    /* 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);
     PL_incgv           = gv_dup(proto_perl->Iincgv, param);
@@ -9924,7 +9942,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_custom_op_descs  = hv_dup_inc(proto_perl->Icustom_op_descs,param);
 
     PL_profiledata     = NULL;
-    PL_rsfp            = fp_dup(proto_perl->Irsfp, '<');
+    PL_rsfp            = fp_dup(proto_perl->Irsfp, '<', param);
     /* PL_rsfp_filters entries have fake IoDIRP() */
     PL_rsfp_filters    = av_dup_inc(proto_perl->Irsfp_filters, param);
 
@@ -10335,3 +10353,4 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 }
 
 #endif /* USE_ITHREADS */
+