cleaning up tests of the 'eval { decl. } <=> runtime decl.' assumption

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

diff --git a/sv.c b/sv.c
index 5c7ccec..effecb7 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1,6 +1,6 @@
 /*    sv.c
  *
- *    Copyright (c) 1991-2002, Larry Wall
+ *    Copyright (c) 1991-2003, 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.
@@ -2273,7 +2273,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
                        this NV is in the preserved range, therefore: */
                     if (!(U_V(SvNVX(sv) > 0 ? SvNVX(sv) : -SvNVX(sv))
                           < (UV)IV_MAX)) {
-                        Perl_croak(aTHX_ "sv_2iv assumed (U_V(fabs(SvNVX(sv))) < (UV)IV_MAX) but SvNVX(sv)=%"NVgf" U_V is 0x%"UVxf", IV_MAX is 0x%"UVxf"\n", SvNVX(sv), U_V(SvNVX(sv)), (UV)IV_MAX);
+                        Perl_croak(aTHX_ "sv_2iv assumed (U_V(fabs((double)SvNVX(sv))) < (UV)IV_MAX) but SvNVX(sv)=%"NVgf" U_V is 0x%"UVxf", IV_MAX is 0x%"UVxf"\n", SvNVX(sv), U_V(SvNVX(sv)), (UV)IV_MAX);
                     }
                 } else {
                     /* IN_UV NOT_INT
@@ -2560,7 +2560,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
                        this NV is in the preserved range, therefore: */
                     if (!(U_V(SvNVX(sv) > 0 ? SvNVX(sv) : -SvNVX(sv))
                           < (UV)IV_MAX)) {
-                        Perl_croak(aTHX_ "sv_2uv assumed (U_V(fabs(SvNVX(sv))) < (UV)IV_MAX) but SvNVX(sv)=%"NVgf" U_V is 0x%"UVxf", IV_MAX is 0x%"UVxf"\n", SvNVX(sv), U_V(SvNVX(sv)), (UV)IV_MAX);
+                        Perl_croak(aTHX_ "sv_2uv assumed (U_V(fabs((double)SvNVX(sv))) < (UV)IV_MAX) but SvNVX(sv)=%"NVgf" U_V is 0x%"UVxf", IV_MAX is 0x%"UVxf"\n", SvNVX(sv), U_V(SvNVX(sv)), (UV)IV_MAX);
                     }
                 } else
                     sv_2iuv_non_preserve (sv, numtype);
@@ -2966,7 +2966,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                case SVt_PVMG:
                    if ( ((SvFLAGS(sv) &
                           (SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG))
-                         == (SVs_OBJECT|SVs_RMG))
+                         == (SVs_OBJECT|SVs_SMG))
                         && (mg = mg_find(sv, PERL_MAGIC_qr))) {
                        regexp *re = (regexp *)mg->mg_obj;
 
@@ -6247,7 +6247,27 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
     (void)SvUPGRADE(sv, SVt_PV);
 
     SvSCREAM_off(sv);
-    SvPOK_only(sv);    /* Validate pointer */
+
+    if (append) {
+       if (PerlIO_isutf8(fp)) {
+           if (!SvUTF8(sv)) {
+               sv_utf8_upgrade_nomg(sv);
+               sv_pos_u2b(sv,&append,0);
+           }
+       } else if (SvUTF8(sv)) {
+           SV *tsv = NEWSV(0,0);
+           sv_gets(tsv, fp, 0);
+           sv_utf8_upgrade_nomg(tsv);
+           SvCUR_set(sv,append);
+           sv_catsv(sv,tsv);
+           sv_free(tsv);
+           goto return_string_or_null;
+       }
+    }
+
+    SvPOK_only(sv);
+    if (PerlIO_isutf8(fp))
+       SvUTF8_on(sv);
 
     if (PL_curcop == &PL_compiling) {
        /* we always read code in line mode */
@@ -6290,7 +6310,7 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
 #endif
       SvCUR_set(sv, bytesread += append);
       buffer[bytesread] = '\0';
-      goto check_utf8_and_return;
+      goto return_string_or_null;
     }
     else if (RsPARA(PL_rs)) {
        rsptr = "\n\n";
@@ -6543,12 +6563,7 @@ screamer2:
        }
     }
 
-check_utf8_and_return:
-    if (PerlIO_isutf8(fp))
-       SvUTF8_on(sv);
-    else
-       SvUTF8_off(sv);
-
+return_string_or_null:
     return (SvCUR(sv) - append) ? SvPVX(sv) : Nullch;
 }
 
@@ -8288,7 +8303,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
     I32 svix = 0;
     static char nullstr[] = "(null)";
     SV *argsv = Nullsv;
-    bool has_utf8 = FALSE; /* has the result utf8? */
+    bool has_utf8; /* has the result utf8? */
+    bool pat_utf8; /* the pattern is in utf8? */
+    SV *nsv = Nullsv;
+
+    has_utf8 = pat_utf8 = DO_UTF8(sv);
 
     /* no matter what, this is a string now */
     (void)SvPV_force(sv, origlen);
@@ -8389,7 +8408,10 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
        /* echo everything up to the next format specification */
        for (q = p; q < patend && *q != '%'; ++q) ;
        if (q > p) {
-           sv_catpvn(sv, p, q - p);
+           if (has_utf8 && !pat_utf8)
+               sv_catpvn_utf8_upgrade(sv, p, q - p, nsv);
+           else
+               sv_catpvn(sv, p, q - p);
            p = q;
        }
        if (q++ >= patend)
@@ -9323,6 +9345,9 @@ Perl_re_dup(pTHX_ REGEXP *r, CLONE_PARAMS *param)
        ret->subbeg  = SAVEPV(r->subbeg);
     else
        ret->subbeg = Nullch;
+#ifdef PERL_COPY_ON_WRITE
+    ret->saved_copy = Nullsv;
+#endif
 
     ptr_table_store(PL_ptr_table, r, ret);
     return ret;
@@ -11187,7 +11212,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_reg_oldsaved    = Nullch;
     PL_reg_oldsavedlen = 0;
 #ifdef PERL_COPY_ON_WRITE
-    PL_nrs             = NullSv;
+    PL_nrs             = Nullsv;
 #endif
     PL_reg_maxiter     = 0;
     PL_reg_leftiter    = 0;