Check if stdio supports tweaking lval and cnt simultaneously.

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

diff --git a/toke.c b/toke.c
index 2f8f015..32073a5 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -813,10 +813,10 @@ Perl_str_to_version(pTHX_ SV *sv)
     bool utf = SvUTF8(sv) ? TRUE : FALSE;
     char *end = start + len;
     while (start < end) {
-       I32 skip;
+       STRLEN skip;
        UV n;
        if (utf)
-           n = utf8_to_uv_chk((U8*)start, &skip, 0);
+           n = utf8_to_uv_chk((U8*)start, len, &skip, 0);
        else {
            n = *(U8*)start;
            skip = 1;
@@ -848,7 +848,7 @@ S_force_version(pTHX_ char *s)
         for (; isDIGIT(*d) || *d == '_' || *d == '.'; d++);
         if (*d == ';' || isSPACE(*d) || *d == '}' || !*d) {
            SV *ver;
-            s = scan_num(s);
+            s = scan_num(s, &yylval);
             version = yylval.opval;
            ver = cSVOPx(version)->op_sv;
            if (SvPOK(ver) && !SvNIOK(ver)) {
@@ -1188,7 +1188,6 @@ S_scan_const(pTHX_ char *start)
     bool dorange = FALSE;                      /* are we in a translit range? */
     bool didrange = FALSE;                     /* did we just finish a range? */
     bool has_utf = FALSE;                      /* embedded \x{} */
-    I32 len;                                   /* ? */
     UV uv;
 
     I32 utf = (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op)
@@ -1329,20 +1328,23 @@ S_scan_const(pTHX_ char *start)
        /* (now in tr/// code again) */
 
        if (*s & 0x80 && thisutf) {
-          (void)utf8_to_uv_chk((U8*)s, &len, 0);
-          if (len == 1) {
-              /* illegal UTF8, make it valid */
-              char *old_pvx = SvPVX(sv);
-              /* need space for one extra char (NOTE: SvCUR() not set here) */
-              d = SvGROW(sv, SvLEN(sv) + 1) + (d - old_pvx);
-              d = (char*)uv_to_utf8((U8*)d, (U8)*s++);
-          }
-          else {
-              while (len--)
-                  *d++ = *s++;
-          }
-          has_utf = TRUE;
-          continue;
+           STRLEN len;
+           UV uv;
+
+           uv = utf8_to_uv_chk((U8*)s, send - s, &len, 1);
+           if (len == 1) {
+               /* illegal UTF8, make it valid */
+               char *old_pvx = SvPVX(sv);
+               /* need space for one extra char (NOTE: SvCUR() not set here) */
+               d = SvGROW(sv, SvLEN(sv) + 1) + (d - old_pvx);
+               d = (char*)uv_to_utf8((U8*)d, (U8)*s++);
+           }
+           else {
+               while (len--)
+                   *d++ = *s++;
+           }
+           has_utf = TRUE;
+           continue;
        }
 
        /* backslashes */
@@ -1398,9 +1400,11 @@ S_scan_const(pTHX_ char *start)
            /* \132 indicates an octal constant */
            case '0': case '1': case '2': case '3':
            case '4': case '5': case '6': case '7':
-               len = 0;        /* disallow underscores */
-               uv = (UV)scan_oct(s, 3, &len);
-               s += len;
+               {
+                   STRLEN len = 0;     /* disallow underscores */
+                   uv = (UV)scan_oct(s, 3, &len);
+                   s += len;
+               }
                goto NUM_ESCAPE_INSERT;
 
            /* \x24 indicates a hex constant */
@@ -1412,14 +1416,18 @@ S_scan_const(pTHX_ char *start)
                        yyerror("Missing right brace on \\x{}");
                        e = s;
                    }
-                   len = 1;            /* allow underscores */
-                    uv = (UV)scan_hex(s + 1, e - s - 1, &len);
-                    s = e + 1;
+                   {
+                       STRLEN len = 1;         /* allow underscores */
+                       uv = (UV)scan_hex(s + 1, e - s - 1, &len);
+                   }
+                   s = e + 1;
                }
                else {
-                   len = 0;            /* disallow underscores */
-                   uv = (UV)scan_hex(s, 2, &len);
-                   s += len;
+                   {
+                       STRLEN len = 0;         /* disallow underscores */
+                       uv = (UV)scan_hex(s, 2, &len);
+                       s += len;
+                   }
                }
 
              NUM_ESCAPE_INSERT:
@@ -1528,8 +1536,10 @@ S_scan_const(pTHX_ char *start)
                *d = toCTRL(*d); 
                d++;
 #else
-               len = *s++;
-               *d++ = toCTRL(len);
+               {
+                   U8 c = *s++;
+                   *d++ = toCTRL(c);
+               }
 #endif
                continue;
 
@@ -2071,20 +2081,15 @@ Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp)
 Perl_yylex(pTHX)
 #endif
 {
-
+    dTHR;
     int r;
 
 #ifdef USE_PURE_BISON
-/* increment level and store the argument pointers */
-    yyactlevel++;
-    if (yyactlevel >= YYMAXLEVEL) {
-/* What to do ??? */
-    }
     yylval_pointer[yyactlevel] = lvalp;
     yychar_pointer[yyactlevel] = lcharp;
-    /* Save last pointer at the bottom */
-    yylval_pointer[0] = lvalp;
-    yychar_pointer[0] = lcharp;
+    yyactlevel++;
+    if (yyactlevel >= YYMAXLEVEL)
+       Perl_croak(aTHX_ "panic: YYMAXLEVEL");
 #endif
 
     r = S_syylex(aTHX);
@@ -3549,7 +3554,7 @@ S_syylex(pTHX) /* need to be separate from yylex for reentrancy */
        /* FALL THROUGH */
     case '0': case '1': case '2': case '3': case '4':
     case '5': case '6': case '7': case '8': case '9':
-       s = scan_num(s);
+       s = scan_num(s, &yylval);
        if (PL_expect == XOPERATOR)
            no_op("Number",s);
        TERM(THING);
@@ -3619,7 +3624,7 @@ S_syylex(pTHX) /* need to be separate from yylex for reentrancy */
            while (isDIGIT(*start) || *start == '_')
                start++;
            if (*start == '.' && isDIGIT(start[1])) {
-               s = scan_num(s);
+               s = scan_num(s, &yylval);
                TERM(THING);
            }
            /* avoid v123abc() or $h{v1}, allow C<print v10;> */
@@ -3630,7 +3635,7 @@ S_syylex(pTHX) /* need to be separate from yylex for reentrancy */
                gv = gv_fetchpv(s, FALSE, SVt_PVCV);
                *start = c;
                if (!gv) {
-                   s = scan_num(s);
+                   s = scan_num(s, &yylval);
                    TERM(THING);
                }
            }
@@ -6739,7 +6744,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
 */
   
 char *
-Perl_scan_num(pTHX_ char *start)
+Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
 {
     register char *s = start;          /* current position in buffer */
     register char *d;                  /* destination in temp buffer */
@@ -7152,9 +7157,9 @@ vstring:
     /* make the op for the constant and return */
 
     if (sv)
-       yylval.opval = newSVOP(OP_CONST, 0, sv);
+       lvalp->opval = newSVOP(OP_CONST, 0, sv);
     else
-       yylval.opval = Nullop;
+       lvalp->opval = Nullop;
 
     return s;
 }