Don't skip too much of the locale error message if no environ array,

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

diff --git a/pp_ctl.c b/pp_ctl.c
index d079e4a..74fc32f 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1,6 +1,6 @@
 /*    pp_ctl.c
  *
- *    Copyright (c) 1991-2000, Larry Wall
+ *    Copyright (c) 1991-2001, 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.
@@ -115,9 +115,16 @@ PP(pp_regcomp)
 
            pm->op_pmflags = pm->op_pmpermflags;        /* reset case sensitivity */
            if (DO_UTF8(tmpstr))
-               pm->op_pmdynflags |= PMdf_UTF8;
+               pm->op_pmdynflags |= PMdf_DYN_UTF8;
+           else {
+               pm->op_pmdynflags &= ~PMdf_DYN_UTF8;
+               if (pm->op_pmdynflags & PMdf_UTF8)
+                   t = (char*)bytes_to_utf8((U8*)t, &len);
+           }
            pm->op_pmregexp = CALLREGCOMP(aTHX_ t, t + len, pm);
-           PL_reginterp_cnt = 0;               /* XXXX Be extra paranoid - needed
+           if (!DO_UTF8(tmpstr) && (pm->op_pmdynflags & PMdf_UTF8))
+               Safefree(t);
+           PL_reginterp_cnt = 0;       /* XXXX Be extra paranoid - needed
                                           inside tie/overload accessors.  */
        }
     }
@@ -157,7 +164,7 @@ PP(pp_substcont)
     register char *m = cx->sb_m;
     char *orig = cx->sb_orig;
     register REGEXP *rx = cx->sb_rx;
-
+    
     rxres_restore(&cx->sb_rxres, rx);
 
     if (cx->sb_iters++) {
@@ -176,8 +183,8 @@ PP(pp_substcont)
                                      : (REXEC_COPY_STR|REXEC_IGNOREPOS|REXEC_NOT_FIRST))))
        {
            SV *targ = cx->sb_targ;
-           sv_catpvn(dstr, s, cx->sb_strend - s);
 
+           sv_catpvn(dstr, s, cx->sb_strend - s);
            cx->sb_rxtainted |= RX_MATCH_TAINTED(rx);
 
            (void)SvOOK_off(targ);
@@ -185,13 +192,15 @@ PP(pp_substcont)
            SvPVX(targ) = SvPVX(dstr);
            SvCUR_set(targ, SvCUR(dstr));
            SvLEN_set(targ, SvLEN(dstr));
+           if (DO_UTF8(dstr))
+               SvUTF8_on(targ);
            SvPVX(dstr) = 0;
            sv_free(dstr);
 
            TAINT_IF(cx->sb_rxtainted & 1);
            PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1)));
 
-           (void)SvPOK_only(targ);
+           (void)SvPOK_only_UTF8(targ);
            TAINT_IF(cx->sb_rxtainted);
            SvSETMAGIC(targ);
            SvTAINT(targ);
@@ -209,7 +218,8 @@ PP(pp_substcont)
        cx->sb_strend = s + (cx->sb_strend - m);
     }
     cx->sb_m = m = rx->startp[0] + orig;
-    sv_catpvn(dstr, s, m-s);
+    if (m > s)
+       sv_catpvn(dstr, s, m-s);
     cx->sb_s = rx->endp[0] + orig;
     { /* Update the pos() information. */
        SV *sv = cx->sb_targ;
@@ -540,7 +550,7 @@ PP(pp_formline)
            s = item;
            if (item_is_utf) {
                while (arg--) {
-                   if (*s & 0x80) {
+                   if (UTF8_IS_CONTINUED(*s)) {
                        switch (UTF8SKIP(s)) {
                        case 7: *t++ = *s++;
                        case 6: *t++ = *s++;
@@ -1235,6 +1245,20 @@ Perl_block_gimme(pTHX)
     }
 }
 
+I32
+Perl_is_lvalue_sub(pTHX)
+{
+    I32 cxix;
+
+    cxix = dopoptosub(cxstack_ix);
+    assert(cxix >= 0);  /* We should only be called from inside subs */
+
+    if (cxstack[cxix].blk_sub.lval && CvLVALUE(cxstack[cxix].blk_sub.cv))
+       return cxstack[cxix].blk_sub.lval;
+    else
+       return 0;
+}
+
 STATIC I32
 S_dopoptosub(pTHX_ I32 startingblock)
 {
@@ -1436,8 +1460,13 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen)
                    }
                }
            }
-           else
+           else {
                sv_setpvn(ERRSV, message, msglen);
+               if (PL_hints & HINT_UTF8)
+                   SvUTF8_on(ERRSV);
+               else
+                   SvUTF8_off(ERRSV);
+           }
        }
        else
            message = SvPVx(ERRSV, msglen);
@@ -2751,7 +2780,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp)
 #else
     SAVEVPTR(PL_op);
 #endif
-    PL_hints = 0;
+    PL_hints &= HINT_UTF8;
 
     PL_op = &dummy;
     PL_op->op_type = OP_ENTEREVAL;
@@ -3081,22 +3110,27 @@ PP(pp_require)
 
     /* prepare to compile file */
 
+#ifdef MACOS_TRADITIONAL
     if (PERL_FILE_IS_ABSOLUTE(name)
-       || (*name == '.' && (name[1] == '/' ||
-                            (name[1] == '.' && name[2] == '/'))))
+       || (*name == ':' && name[1] != ':' && strchr(name+2, ':')))
     {
        tryname = name;
        tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE);
-#ifdef MACOS_TRADITIONAL
        /* We consider paths of the form :a:b ambiguous and interpret them first
           as global then as local
        */
-       if (!tryrsfp && name[0] == ':' && name[1] != ':' && strchr(name+2, ':'))
+       if (!tryrsfp && *name == ':' && name[1] != ':' && strchr(name+2, ':'))
            goto trylocal;
     }
     else
 trylocal: {
 #else
+    if (PERL_FILE_IS_ABSOLUTE(name)
+       || (*name == '.' && (name[1] == '/' ||
+                            (name[1] == '.' && name[2] == '/'))))
+    {
+       tryname = name;
+       tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE);
     }
     else {
 #endif