Upgrade to Test::Simple 0.61

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

diff --git a/toke.c b/toke.c
index ae56a6f..93623f6 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -664,6 +664,43 @@ S_incline(pTHX_ char *s)
     ch = *t;
     *t = '\0';
     if (t - s > 0) {
+#ifndef USE_ITHREADS
+       const char *cf = CopFILE(PL_curcop);
+       if (cf && strlen(cf) > 7 && strnEQ(cf, "(eval ", 6)) {
+           /* must copy *{"::_<(eval N)[oldfilename:L]"}
+            * to *{"::_<newfilename"} */
+           char smallbuf[256], smallbuf2[256];
+           char *tmpbuf, *tmpbuf2;
+           GV **gvp, *gv2;
+           STRLEN tmplen = strlen(cf);
+           STRLEN tmplen2 = strlen(s);
+           if (tmplen + 3 < sizeof smallbuf)
+               tmpbuf = smallbuf;
+           else
+               Newx(tmpbuf, tmplen + 3, char);
+           if (tmplen2 + 3 < sizeof smallbuf2)
+               tmpbuf2 = smallbuf2;
+           else
+               Newx(tmpbuf2, tmplen2 + 3, char);
+           tmpbuf[0] = tmpbuf2[0] = '_';
+           tmpbuf[1] = tmpbuf2[1] = '<';
+           memcpy(tmpbuf + 2, cf, ++tmplen);
+           memcpy(tmpbuf2 + 2, s, ++tmplen2);
+           ++tmplen; ++tmplen2;
+           gvp = (GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, FALSE);
+           if (gvp) {
+               gv2 = *(GV**)hv_fetch(PL_defstash, tmpbuf2, tmplen2, TRUE);
+               if (!isGV(gv2))
+                   gv_init(gv2, PL_defstash, tmpbuf2, tmplen2, FALSE);
+               /* adjust ${"::_<newfilename"} to store the new file name */
+               GvSV(gv2) = newSVpvn(tmpbuf2 + 2, tmplen2 - 2);
+               GvHV(gv2) = (HV*)SvREFCNT_inc(GvHV(*gvp));
+               GvAV(gv2) = (AV*)SvREFCNT_inc(GvAV(*gvp));
+           }
+           if (tmpbuf != smallbuf) Safefree(tmpbuf);
+           if (tmpbuf2 != smallbuf2) Safefree(tmpbuf2);
+       }
+#endif
        CopFILE_free(PL_curcop);
        CopFILE_set(PL_curcop, s);
     }
@@ -1368,6 +1405,9 @@ S_scan_const(pTHX_ char *start)
     I32  has_utf8 = FALSE;                     /* Output constant is UTF8 */
     I32  this_utf8 = UTF;                      /* The source string is assumed to be UTF8 */
     UV uv;
+#ifdef EBCDIC
+    UV literal_endpoint = 0;
+#endif
 
     const char *leaveit =      /* set of acceptably-backslashed characters */
        PL_lex_inpat
@@ -1417,8 +1457,9 @@ S_scan_const(pTHX_ char *start)
                 }
 
 #ifdef EBCDIC
-               if ((isLOWER(min) && isLOWER(max)) ||
-                   (isUPPER(min) && isUPPER(max))) {
+               if (literal_endpoint == 2 &&
+                   ((isLOWER(min) && isLOWER(max)) ||
+                    (isUPPER(min) && isUPPER(max)))) {
                    if (isLOWER(min)) {
                        for (i = min; i <= max; i++)
                            if (isLOWER(i))
@@ -1437,6 +1478,9 @@ S_scan_const(pTHX_ char *start)
                /* mark the range as done, and continue */
                dorange = FALSE;
                didrange = TRUE;
+#ifdef EBCDIC
+               literal_endpoint = 0;
+#endif
                continue;
            }
 
@@ -1455,6 +1499,9 @@ S_scan_const(pTHX_ char *start)
            }
            else {
                didrange = FALSE;
+#ifdef EBCDIC
+               literal_endpoint = 0;
+#endif
            }
        }
 
@@ -1788,6 +1835,10 @@ S_scan_const(pTHX_ char *start)
            s++;
            continue;
        } /* end if (backslash) */
+#ifdef EBCDIC
+       else
+           literal_endpoint++;
+#endif
 
     default_action:
        /* If we started with encoded form, or already know we want it
@@ -2279,6 +2330,30 @@ S_find_in_my_stash(pTHX_ const char *pkgname, I32 len)
     return gv_stashpv(pkgname, FALSE);
 }
 
+STATIC char *
+S_tokenize_use(pTHX_ int is_use, char *s) {
+    if (PL_expect != XSTATE)
+       yyerror(Perl_form(aTHX_ "\"%s\" not allowed in expression",
+                   is_use ? "use" : "no"));
+    s = skipspace(s);
+    if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) {
+       s = force_version(s, TRUE);
+       if (*s == ';' || (s = skipspace(s), *s == ';')) {
+           PL_nextval[PL_nexttoke].opval = Nullop;
+           force_next(WORD);
+       }
+       else if (*s == 'v') {
+           s = force_word(s,WORD,FALSE,TRUE,FALSE);
+           s = force_version(s, FALSE);
+       }
+    }
+    else {
+       s = force_word(s,WORD,FALSE,TRUE,FALSE);
+       s = force_version(s, FALSE);
+    }
+    yylval.ival = is_use;
+    return s;
+}
 #ifdef DEBUGGING
     static const char* const exp_name[] =
        { "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "ATTRBLOCK",
@@ -3515,7 +3590,7 @@ Perl_yylex(pTHX)
            OPERATOR(',');
        if (tmp == '~')
            PMop(OP_MATCH);
-       if (tmp && isSPACE(*s) && strchr("+-*/%.^&|<",tmp) && ckWARN(WARN_SYNTAX))
+       if (tmp && isSPACE(*s) && ckWARN(WARN_SYNTAX) && strchr("+-*/%.^&|<",tmp))
            Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Reversed %c= operator",(int)tmp);
        s--;
        if (PL_expect == XSTATE && isALPHA(tmp) &&
@@ -3685,8 +3760,8 @@ Perl_yylex(pTHX)
            else if (*s == '{') {
                char *t;
                PL_tokenbuf[0] = '%';
-               if (strEQ(PL_tokenbuf+1, "SIG") && (t = strchr(s, '}'))
-                   && (t = strchr(t, '=')) && ckWARN(WARN_SYNTAX))
+               if (strEQ(PL_tokenbuf+1, "SIG")  && ckWARN(WARN_SYNTAX)
+                   && (t = strchr(s, '}')) && (t = strchr(t, '=')))
                {
                    char tmpbuf[sizeof PL_tokenbuf];
                    for (t++; isSPACE(*t); t++) ;
@@ -4445,6 +4520,9 @@ Perl_yylex(pTHX)
                    Perl_croak(aTHX_ "CORE::%s is not a keyword", PL_tokenbuf);
                if (tmp < 0)
                    tmp = -tmp;
+               else if (tmp == KEY_require)
+                   /* that's a way to remember we saw "CORE::" */
+                   orig_keyword = KEY_require;
                goto reserved_word;
            }
            goto just_a_word;
@@ -4857,11 +4935,7 @@ Perl_yylex(pTHX)
            Eop(OP_SNE);
 
        case KEY_no:
-           if (PL_expect != XSTATE)
-               yyerror("\"no\" not allowed in expression");
-           s = force_word(s,WORD,FALSE,TRUE,FALSE);
-           s = force_version(s, FALSE);
-           yylval.ival = 0;
+           s = tokenize_use(0, s);
            OPERATOR(USE);
 
        case KEY_not:
@@ -5030,7 +5104,18 @@ Perl_yylex(pTHX)
                else if (*s == '<')
                    yyerror("<> should be quotes");
            }
-           UNI(OP_REQUIRE);
+           if (orig_keyword == KEY_require) {
+               orig_keyword = 0;
+               yylval.ival = 1;
+           }
+           else 
+               yylval.ival = 0;
+           PL_expect = XTERM;
+           PL_bufptr = s;
+           PL_last_uni = PL_oldbufptr;
+           PL_last_lop_op = OP_REQUIRE;
+           s = skipspace(s);
+           return REPORT( (int)REQUIRE );
 
        case KEY_reset:
            UNI(OP_RESET);
@@ -5393,25 +5478,7 @@ Perl_yylex(pTHX)
            LOP(OP_UNSHIFT,XTERM);
 
        case KEY_use:
-           if (PL_expect != XSTATE)
-               yyerror("\"use\" not allowed in expression");
-           s = skipspace(s);
-           if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) {
-               s = force_version(s, TRUE);
-               if (*s == ';' || (s = skipspace(s), *s == ';')) {
-                   PL_nextval[PL_nexttoke].opval = Nullop;
-                   force_next(WORD);
-               }
-               else if (*s == 'v') {
-                   s = force_word(s,WORD,FALSE,TRUE,FALSE);
-                   s = force_version(s, FALSE);
-               }
-           }
-           else {
-               s = force_word(s,WORD,FALSE,TRUE,FALSE);
-               s = force_version(s, FALSE);
-           }
-           yylval.ival = 1;
+           s = tokenize_use(1, s);
            OPERATOR(USE);
 
        case KEY_values: