default mkdir() mode argument to 0777

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

diff --git a/toke.c b/toke.c
index b9a12c4..6000aba 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1,6 +1,6 @@
 /*    toke.c
  *
- *    Copyright (c) 1991-1999, Larry Wall
+ *    Copyright (c) 1991-2000, 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.
@@ -58,13 +58,6 @@ static void restore_rsfp(pTHXo_ void *f);
 #define LEX_FORMLINE            1
 #define LEX_KNOWNEXT            0
 
-#ifdef I_FCNTL
-#include <fcntl.h>
-#endif
-#ifdef I_SYS_FILE
-#include <sys/file.h>
-#endif
-
 /* XXX If this causes problems, set i_unistd=undef in the hint file.  */
 #ifdef I_UNISTD
 #  include <unistd.h> /* Needed for execv() */
@@ -464,17 +457,22 @@ S_incline(pTHX_ char *s)
     dTHR;
     char *t;
     char *n;
+    char *e;
     char ch;
-    int sawline = 0;
 
     CopLINE_inc(PL_curcop);
     if (*s++ != '#')
        return;
     while (*s == ' ' || *s == '\t') s++;
-    if (strnEQ(s, "line ", 5)) {
-       s += 5;
-       sawline = 1;
-    }
+    if (strnEQ(s, "line", 4))
+       s += 4;
+    else
+       return;
+    if (*s == ' ' || *s == '\t')
+       s++;
+    else 
+       return;
+    while (*s == ' ' || *s == '\t') s++;
     if (!isDIGIT(*s))
        return;
     n = s;
@@ -482,13 +480,19 @@ S_incline(pTHX_ char *s)
        s++;
     while (*s == ' ' || *s == '\t')
        s++;
-    if (*s == '"' && (t = strchr(s+1, '"')))
+    if (*s == '"' && (t = strchr(s+1, '"'))) {
        s++;
+       e = t + 1;
+    }
     else {
-       if (!sawline)
-           return;             /* false alarm */
        for (t = s; !isSPACE(*t); t++) ;
+       e = t;
     }
+    while (*e == ' ' || *e == '\t' || *e == '\r' || *e == '\f')
+       e++;
+    if (*e != '\n' && *e != '\0')
+       return;         /* false alarm */
+
     ch = *t;
     *t = '\0';
     if (t - s > 0)
@@ -825,7 +829,7 @@ S_force_version(pTHX_ char *s)
        if (*d == 'v')
            d++;
         for (; isDIGIT(*d) || *d == '_' || *d == '.'; d++);
-        if ((*d == ';' || isSPACE(*d)) && *(skipspace(d)) != ',') {
+        if (*d == ';' || isSPACE(*d) || *d == '}' || !*d) {
             s = scan_num(s);
             /* real VERSION number -- GBARR */
             version = yylval.opval;
@@ -1356,18 +1360,24 @@ S_scan_const(pTHX_ char *start)
                ++s;
                if (*s == '{') {
                    char* e = strchr(s, '}');
+                   UV uv;
 
                    if (!e) {
                        yyerror("Missing right brace on \\x{}");
                        e = s;
                    }
                    /* note: utf always shorter than hex */
-                   d = (char*)uv_to_utf8((U8*)d,
-                                         (UV)scan_hex(s + 1, e - s - 1, &len));
+                   uv = (UV)scan_hex(s + 1, e - s - 1, &len);
+                   if (uv > 127) {
+                       d = (char*)uv_to_utf8((U8*)d, uv);
+                       has_utf = TRUE;
+                   }
+                   else
+                       *d++ = (char)uv;
                    s = e + 1;
-                   has_utf = TRUE;
                }
                else {
+                   /* XXX collapse this branch into the one above */
                    UV uv = (UV)scan_hex(s, 2, &len);
                    if (utf && PL_lex_inwhat == OP_TRANS &&
                        utf != (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF))
@@ -3945,7 +3955,7 @@ Perl_yylex(pTHX)
                for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ;
                if (*d != '0' && isDIGIT(*d))
                    Perl_warner(aTHX_ WARN_OCTAL,
-                               "chmod: mode argument is missing initial 0");
+                               "chmod() mode argument is missing initial 0");
            }
            LOP(OP_CHMOD,XTERM);
 
@@ -6887,9 +6897,10 @@ Perl_scan_num(pTHX_ char *start)
                pos++;
            if (*pos == '.' && isDIGIT(pos[1])) {
                UV rev;
-               U8 tmpbuf[10];
+               U8 tmpbuf[UTF8_MAXLEN];
                U8 *tmpend;
                NV nshift = 1.0;
+               bool utf8 = FALSE;
                s++;                            /* get past 'v' */
 
                sv = NEWSV(92,5);
@@ -6904,8 +6915,14 @@ Perl_scan_num(pTHX_ char *start)
                    while (isDIGIT(*pos))
                        pos++;
 
-                   tmpend = uv_to_utf8(tmpbuf, rev);
-                   *tmpend = '\0';
+                   if (rev > 127) {
+                       tmpend = uv_to_utf8(tmpbuf, rev);
+                       utf8 = TRUE;
+                   }
+                   else {
+                       tmpbuf[0] = (U8)rev;
+                       tmpend = &tmpbuf[1];
+                   }
                    sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
                    if (rev > 0)
                        SvNVX(sv) += (NV)rev/nshift;
@@ -6917,7 +6934,7 @@ Perl_scan_num(pTHX_ char *start)
                rev = atoi(s);
                s = pos;
                tmpend = uv_to_utf8(tmpbuf, rev);
-               *tmpend = '\0';
+               utf8 = utf8 || rev > 127;
                sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
                if (rev > 0)
                    SvNVX(sv) += (NV)rev/nshift;
@@ -6925,7 +6942,10 @@ Perl_scan_num(pTHX_ char *start)
                SvPOK_on(sv);
                SvNOK_on(sv);
                SvREADONLY_on(sv);
-               SvUTF8_on(sv);
+               if (utf8) {
+                   SvUTF8_on(sv);
+                   sv_utf8_downgrade(sv, TRUE);
+               }
            }
        }
        break;
@@ -7125,7 +7145,12 @@ Perl_yyerror(pTHX_ char *s)
     }
     else if (yychar > 255)
        where = "next token ???";
+#ifdef USE_PURE_BISON
+/*  GNU Bison sets the value -2 */
+    else if (yychar == -2) {
+#else
     else if ((yychar & 127) == 127) {
+#endif
        if (PL_lex_state == LEX_NORMAL ||
           (PL_lex_state == LEX_KNOWNEXT && PL_lex_defer == LEX_NORMAL))
            where = "at end of line";