Integrate MIME::Base64 2.16 from CPAN. (Do we really want the
[p5sagit/p5-mst-13.2.git] / toke.c
diff --git a/toke.c b/toke.c
index cb8fbea..e7834c4 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -2266,35 +2266,40 @@ Perl_yylex(pTHX)
            DEBUG_T({ PerlIO_printf(Perl_debug_log,
               "### Saw case modifier at '%s'\n", PL_bufptr); });
            s = PL_bufptr + 1;
-           if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3))
-               tmp = *s, *s = s[2], s[2] = (char)tmp;  /* misordered... */
-           if (strchr("LU", *s) &&
-               (strchr(PL_lex_casestack, 'L') || strchr(PL_lex_casestack, 'U')))
-           {
-               PL_lex_casestack[--PL_lex_casemods] = '\0';
-               return ')';
+           if (s[1] == '\\' && s[2] == 'E') {
+               PL_bufptr = s + 3;
+               PL_lex_state = LEX_INTERPCONCAT;
+               return yylex();
            }
-           if (PL_lex_casemods > 10) {
-               Renew(PL_lex_casestack, PL_lex_casemods + 2, char);
+           else {
+               if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3))
+                   tmp = *s, *s = s[2], s[2] = (char)tmp;      /* misordered... */
+               if (strchr("LU", *s) &&
+                   (strchr(PL_lex_casestack, 'L') || strchr(PL_lex_casestack, 'U'))) {
+                   PL_lex_casestack[--PL_lex_casemods] = '\0';
+                   return ')';
+               }
+               if (PL_lex_casemods > 10)
+                   Renew(PL_lex_casestack, PL_lex_casemods + 2, char);
+               PL_lex_casestack[PL_lex_casemods++] = *s;
+               PL_lex_casestack[PL_lex_casemods] = '\0';
+               PL_lex_state = LEX_INTERPCONCAT;
+               PL_nextval[PL_nexttoke].ival = 0;
+               force_next('(');
+               if (*s == 'l')
+                   PL_nextval[PL_nexttoke].ival = OP_LCFIRST;
+               else if (*s == 'u')
+                   PL_nextval[PL_nexttoke].ival = OP_UCFIRST;
+               else if (*s == 'L')
+                   PL_nextval[PL_nexttoke].ival = OP_LC;
+               else if (*s == 'U')
+                   PL_nextval[PL_nexttoke].ival = OP_UC;
+               else if (*s == 'Q')
+                   PL_nextval[PL_nexttoke].ival = OP_QUOTEMETA;
+               else
+                   Perl_croak(aTHX_ "panic: yylex");
+               PL_bufptr = s + 1;
            }
-           PL_lex_casestack[PL_lex_casemods++] = *s;
-           PL_lex_casestack[PL_lex_casemods] = '\0';
-           PL_lex_state = LEX_INTERPCONCAT;
-           PL_nextval[PL_nexttoke].ival = 0;
-           force_next('(');
-           if (*s == 'l')
-               PL_nextval[PL_nexttoke].ival = OP_LCFIRST;
-           else if (*s == 'u')
-               PL_nextval[PL_nexttoke].ival = OP_UCFIRST;
-           else if (*s == 'L')
-               PL_nextval[PL_nexttoke].ival = OP_LC;
-           else if (*s == 'U')
-               PL_nextval[PL_nexttoke].ival = OP_UC;
-           else if (*s == 'Q')
-               PL_nextval[PL_nexttoke].ival = OP_QUOTEMETA;
-           else
-               Perl_croak(aTHX_ "panic: yylex");
-           PL_bufptr = s + 1;
            force_next(FUNC);
            if (PL_lex_starts) {
                s = PL_bufptr;
@@ -5037,8 +5042,8 @@ Perl_yylex(pTHX)
                    d[tmp] = '\0';
                    if (bad_proto && ckWARN(WARN_SYNTAX))
                        Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                                   "Illegal character in prototype for %s : %s",
-                                   SvPVX(PL_subname), d);
+                                   "Illegal character in prototype for %"SVf" : %s",
+                                   PL_subname, d);
                    SvCUR(PL_lex_stuff) = tmp;
                    have_proto = TRUE;
 
@@ -5279,7 +5284,9 @@ S_pending_ident(pTHX)
     */
 
     if (!strchr(PL_tokenbuf,':')) {
-        if ((tmp = pad_findmy(PL_tokenbuf)) != NOT_IN_PAD) {
+       if (!PL_in_my)
+           tmp = pad_findmy(PL_tokenbuf);
+        if (tmp != NOT_IN_PAD) {
             /* might be an "our" variable" */
             if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) {
                 /* build ops for a bareword */