Mention /usr/share/locale.

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

diff --git a/toke.c b/toke.c
index fb54cee..fca117b 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1056,7 +1056,7 @@ scan_const(char *start)
            s++;
 
            /* some backslashes we leave behind */
-           if (*s && strchr(leaveit, *s)) {
+           if (*leaveit && *s && strchr(leaveit, *s)) {
                *d++ = '\\';
                *d++ = *s++;
                continue;
@@ -1089,10 +1089,17 @@ scan_const(char *start)
                    continue;
                }
                /* FALL THROUGH */
-           /* default action is to copy the quoted character */
            default:
-               *d++ = *s++;
-               continue;
+               {
+                   dTHR;
+                   if (ckWARN(WARN_UNSAFE) && isALPHA(*s))
+                       warner(WARN_UNSAFE, 
+                              "Unrecognized escape \\%c passed through",
+                              *s);
+                   /* default action is to copy the quoted character */
+                   *d++ = *s++;
+                   continue;
+               }
 
            /* \132 indicates an octal constant */
            case '0': case '1': case '2': case '3':
@@ -1452,8 +1459,10 @@ filter_add(filter_t funcp, SV *datasv)
     if (!SvUPGRADE(datasv, SVt_PVIO))
         die("Can't upgrade filter_add data to SVt_PVIO");
     IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
-    if (filter_debug)
-       warn("filter_add func %p (%s)", funcp, SvPV(datasv,PL_na));
+    if (filter_debug) {
+       STRLEN n_a;
+       warn("filter_add func %p (%s)", funcp, SvPV(datasv, n_a));
+    }
     av_unshift(PL_rsfp_filters, 1);
     av_store(PL_rsfp_filters, 0, datasv) ;
     return(datasv);
@@ -1529,9 +1538,11 @@ filter_read(int idx, SV *buf_sv, int maxlen)
     }
     /* Get function pointer hidden within datasv       */
     funcp = (filter_t)IoDIRP(datasv);
-    if (filter_debug)
+    if (filter_debug) {
+       STRLEN n_a;
        warn("filter_read %d: via function %p (%s)\n",
-               idx, funcp, SvPV(datasv,PL_na));
+               idx, funcp, SvPV(datasv,n_a));
+    }
     /* Call function. The function is expected to      */
     /* call "FILTER_READ(idx+1, buf_sv)" first.                */
     /* Return: <0:error, =0:eof, >0:not eof            */
@@ -2965,6 +2976,7 @@ int yylex(PERL_YYLEX_PARAM_DECL)
     case 'z': case 'Z':
 
       keylookup: {
+       STRLEN n_a;
        gv = Nullgv;
        gvp = 0;
 
@@ -3161,7 +3173,7 @@ int yylex(PERL_YYLEX_PARAM_DECL)
                    if (gv && GvCVu(gv)) {
                        CV *cv;
                        if ((cv = GvCV(gv)) && SvPOK(cv))
-                           PL_last_proto = SvPV((SV*)cv, PL_na);
+                           PL_last_proto = SvPV((SV*)cv, n_a);
                        for (d = s + 1; *d == ' ' || *d == '\t'; d++) ;
                        if (*d == ')' && (sv = cv_const_sv(cv))) {
                            s = d + 1;
@@ -4119,7 +4131,7 @@ int yylex(PERL_YYLEX_PARAM_DECL)
                PL_lex_stuff = Nullsv;
            }
 
-           if (*SvPV(PL_subname,PL_na) == '?') {
+           if (*SvPV(PL_subname,n_a) == '?') {
                sv_setpv(PL_subname,"__ANON__");
                TOKEN(ANONSUB);
            }
@@ -4959,7 +4971,6 @@ new_constant(char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type)
     bool oldcatch = CATCH_GET;
     SV **cvp;
     SV *cv, *typesv;
-    char buf[128];
            
     if (!table) {
        yyerror("%^H is not defined");
@@ -4967,6 +4978,7 @@ new_constant(char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type)
     }
     cvp = hv_fetch(table, key, strlen(key), FALSE);
     if (!cvp || !SvOK(*cvp)) {
+       char buf[128];
        sprintf(buf,"$^H{%s} is not defined", key);
        yyerror(buf);
        return sv;
@@ -5012,6 +5024,7 @@ new_constant(char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type)
     POPSTACK;
 
     if (!SvOK(res)) {
+       char buf[128];
        sprintf(buf,"Call to &{$^H{%s}} did not return a defined value", key);
        yyerror(buf);
     }
@@ -5889,7 +5902,7 @@ scan_str(char *start)
 
   Read a number in any of the formats that Perl accepts:
 
-  0(x[0-7A-F]+)|([0-7]+)
+  0(x[0-7A-F]+)|([0-7]+)|(b[01])
   [\d_]+(\.[\d_]*)?[Ee](\d+)
 
   Underbars (_) are allowed in decimal numbers.  If -w is on,
@@ -5923,18 +5936,19 @@ scan_num(char *start)
       croak("panic: scan_num");
       
     /* if it starts with a 0, it could be an octal number, a decimal in
-       0.13 disguise, or a hexadecimal number.
+       0.13 disguise, or a hexadecimal number, or a binary number.
     */
     case '0':
        {
          /* variables:
             u          holds the "number so far"
-            shift      the power of 2 of the base (hex == 4, octal == 3)
+            shift      the power of 2 of the base
+                       (hex == 4, octal == 3, binary == 1)
             overflowed was the number more than we can hold?
 
             Shift is used when we add a digit.  It also serves as an "are
-            we in octal or hex?" indicator to disallow hex characters when
-            in octal mode.
+            we in octal/hex/binary?" indicator to disallow hex characters
+            when in octal mode.
           */
            UV u;
            I32 shift;
@@ -5944,6 +5958,9 @@ scan_num(char *start)
            if (s[1] == 'x') {
                shift = 4;
                s += 2;
+           } else if (s[1] == 'b') {
+               shift = 1;
+               s += 2;
            }
            /* check for a decimal in disguise */
            else if (s[1] == '.')
@@ -5953,7 +5970,7 @@ scan_num(char *start)
                shift = 3;
            u = 0;
 
-           /* read the rest of the octal number */
+           /* read the rest of the number */
            for (;;) {
                UV n, b;        /* n is used in the overflow test, b is the digit we're adding on */
 
@@ -5970,13 +5987,21 @@ scan_num(char *start)
 
                /* 8 and 9 are not octal */
                case '8': case '9':
-                   if (shift != 4)
+                   if (shift == 3)
                        yyerror("Illegal octal digit");
+                   else
+                       if (shift == 1)
+                           yyerror("Illegal binary digit");
                    /* FALL THROUGH */
 
                /* octal digits */
-               case '0': case '1': case '2': case '3': case '4':
+               case '2': case '3': case '4':
                case '5': case '6': case '7':
+                   if (shift == 1)
+                       yyerror("Illegal binary digit");
+                   /* FALL THROUGH */
+
+               case '0': case '1':
                    b = *s++ & 15;              /* ASCII digit -> value of digit */
                    goto digit;
 
@@ -5997,7 +6022,8 @@ scan_num(char *start)
                    if (!overflowed && (n >> shift) != u
                        && !(PL_hints & HINT_NEW_BINARY)) {
                        warn("Integer overflow in %s number",
-                            (shift == 4) ? "hex" : "octal");
+                            (shift == 4) ? "hex"
+                            : ((shift == 3) ? "octal" : "binary"));
                        overflowed = TRUE;
                    }
                    u = n | b;          /* add the digit to the end */
@@ -6148,7 +6174,7 @@ scan_formline(register char *s)
 #else
            for (t = s+1;*t == ' ' || *t == '\t' || *t == '\r'; t++) ;
 #endif
-           if (*t == '\n')
+           if (*t == '\n' || t == PL_bufend)
                break;
        }
        if (PL_in_eval && !PL_rsfp) {