More tests.

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

diff --git a/toke.c b/toke.c
index d535442..1d0dc7c 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -27,20 +27,23 @@
 
 static char ident_too_long[] = "Identifier too long";
 
-static void restore_rsfp(pTHXo_ void *f);
+static void restore_rsfp(pTHX_ void *f);
 #ifndef PERL_NO_UTF16_FILTER
-static I32 utf16_textfilter(pTHXo_ int idx, SV *sv, int maxlen);
-static I32 utf16rev_textfilter(pTHXo_ int idx, SV *sv, int maxlen);
+static I32 utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen);
+static I32 utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen);
 #endif
 
 #define XFAKEBRACK 128
 #define XENUMMASK 127
 
-#ifdef EBCDIC
-/* For now 'use utf8' does not affect tokenizer on EBCDIC */
-#define UTF (PL_linestr && DO_UTF8(PL_linestr))
+#ifdef USE_UTF8_SCRIPTS
+#   define UTF (!IN_BYTES)
 #else
-#define UTF ((PL_linestr && DO_UTF8(PL_linestr)) || (PL_hints & HINT_UTF8))
+#   ifdef EBCDIC /* For now 'use utf8' does not affect tokenizer on EBCDIC */
+#       define UTF (PL_linestr && DO_UTF8(PL_linestr))
+#   else
+#       define UTF ((PL_linestr && DO_UTF8(PL_linestr)) || (PL_hints & HINT_UTF8))
+#   endif
 #endif
 
 /* In variables named $^X, these are the legal values for X.
@@ -1431,8 +1434,9 @@ S_scan_const(pTHX_ char *start)
            case '0': case '1': case '2': case '3':
            case '4': case '5': case '6': case '7':
                {
-                   STRLEN len = 0;     /* disallow underscores */
-                   uv = (UV)scan_oct(s, 3, &len);
+                    I32 flags = 0;
+                    STRLEN len = 3;
+                   uv = grok_oct(s, &len, &flags, NULL);
                    s += len;
                }
                goto NUM_ESCAPE_INSERT;
@@ -1442,20 +1446,23 @@ S_scan_const(pTHX_ char *start)
                ++s;
                if (*s == '{') {
                    char* e = strchr(s, '}');
-                   STRLEN len = 1;             /* allow underscores */
+                    I32 flags = PERL_SCAN_ALLOW_UNDERSCORES;
+                   STRLEN len;
 
+                    ++s;
                    if (!e) {
                        yyerror("Missing right brace on \\x{}");
-                       ++s;
                        continue;
                    }
-                   uv = (UV)scan_hex(s + 1, e - s - 1, &len);
+                    len = e - s;
+                   uv = grok_hex(s, &len, &flags, NULL);
                    s = e + 1;
                }
                else {
                    {
-                       STRLEN len = 0;         /* disallow underscores */
-                       uv = (UV)scan_hex(s, 2, &len);
+                       STRLEN len = 2;
+                        I32 flags = 0;
+                       uv = grok_hex(s, &len, &flags, NULL);
                        s += len;
                    }
                }
@@ -2048,7 +2055,7 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
     /* Call function. The function is expected to      */
     /* call "FILTER_READ(idx+1, buf_sv)" first.                */
     /* Return: <0:error, =0:eof, >0:not eof            */
-    return (*funcp)(aTHXo_ idx, buf_sv, maxlen);
+    return (*funcp)(aTHX_ idx, buf_sv, maxlen);
 }
 
 STATIC char *
@@ -2282,13 +2289,13 @@ Perl_yylex(pTHX)
        if (PL_lex_dojoin) {
            PL_nextval[PL_nexttoke].ival = 0;
            force_next(',');
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
            PL_nextval[PL_nexttoke].opval = newOP(OP_THREADSV, 0);
            PL_nextval[PL_nexttoke].opval->op_targ = find_threadsv("\"");
            force_next(PRIVATEREF);
 #else
            force_ident("\"", '$');
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
            PL_nextval[PL_nexttoke].ival = 0;
            force_next('$');
            PL_nextval[PL_nexttoke].ival = 0;
@@ -3993,7 +4000,7 @@ Perl_yylex(pTHX)
                    if (ckWARN(WARN_RESERVED)) {
                        if (lastchar != '-') {
                            for (d = PL_tokenbuf; *d && isLOWER(*d); d++) ;
-                           if (!*d)
+                           if (!*d && strNE(PL_tokenbuf,"main"))
                                Perl_warner(aTHX_ WARN_RESERVED, PL_warn_reserved,
                                       PL_tokenbuf);
                        }
@@ -5161,7 +5168,7 @@ S_pending_ident(pTHX)
     */
 
     if (!strchr(PL_tokenbuf,':')) {
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
         /* Check for single character per-thread SVs */
         if (PL_tokenbuf[0] == '$' && PL_tokenbuf[2] == '\0'
             && !isALPHA(PL_tokenbuf[1]) /* Rule out obvious non-threadsvs */
@@ -5171,7 +5178,7 @@ S_pending_ident(pTHX)
             yylval.opval->op_targ = tmp;
             return PRIVATEREF;
         }
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
         if ((tmp = pad_findmy(PL_tokenbuf)) != NOT_IN_PAD) {
             SV *namesv = AvARRAY(PL_comppad_name)[tmp];
             /* might be an "our" variable" */
@@ -7452,11 +7459,11 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
     PL_min_intro_pending = 0;
     PL_padix = 0;
     PL_subline = CopLINE(PL_curcop);
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     av_store(PL_comppad_name, 0, newSVpvn("@_", 2));
     PL_curpad[0] = (SV*)newAV();
     SvPADMY_on(PL_curpad[0]);  /* XXX Needed? */
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 
     comppadlist = newAV();
     AvREAL_off(comppadlist);
@@ -7465,11 +7472,11 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
 
     CvPADLIST(PL_compcv) = comppadlist;
     CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(outsidecv);
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     CvOWNER(PL_compcv) = 0;
     New(666, CvMUTEXP(PL_compcv), 1, perl_mutex);
     MUTEX_INIT(CvMUTEXP(PL_compcv));
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 
     return oldsavestack_ix;
 }
@@ -7644,17 +7651,13 @@ S_swallow_bom(pTHX_ U8 *s)
     return (char*)s;
 }
 
-#ifdef PERL_OBJECT
-#include "XSUB.h"
-#endif
-
 /*
  * restore_rsfp
  * Restore a source filter.
  */
 
 static void
-restore_rsfp(pTHXo_ void *f)
+restore_rsfp(pTHX_ void *f)
 {
     PerlIO *fp = (PerlIO*)f;
 
@@ -7667,7 +7670,7 @@ restore_rsfp(pTHXo_ void *f)
 
 #ifndef PERL_NO_UTF16_FILTER
 static I32
-utf16_textfilter(pTHXo_ int idx, SV *sv, int maxlen)
+utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen)
 {
     I32 count = FILTER_READ(idx+1, sv, maxlen);
     if (count) {
@@ -7686,7 +7689,7 @@ utf16_textfilter(pTHXo_ int idx, SV *sv, int maxlen)
 }
 
 static I32
-utf16rev_textfilter(pTHXo_ int idx, SV *sv, int maxlen)
+utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen)
 {
     I32 count = FILTER_READ(idx+1, sv, maxlen);
     if (count) {