implement C<goto &func> and other fixes (via private mail)

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

diff --git a/toke.c b/toke.c
index e14ebfd..839ef14 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -109,6 +109,20 @@ static char ident_too_long[] = "Identifier too long";
 #undef ff_next
 #endif
 
+#ifdef USE_PURE_BISON
+YYSTYPE* yylval_pointer = NULL;
+int* yychar_pointer = NULL;
+#ifdef EMBED
+#undef yylval
+#undef yychar
+#endif
+#define yylval (*yylval_pointer)
+#define yychar (*yychar_pointer)
+#define YYLEXPARAM yylval_pointer,yychar_pointer
+#else
+#define YYLEXPARAM
+#endif
+
 #include "keywords.h"
 
 #ifdef CLINE
@@ -784,7 +798,7 @@ sublex_done(void)
 
     if (PL_lex_casemods) {             /* oops, we've got some unbalanced parens */
        PL_lex_state = LEX_INTERPCASEMOD;
-       return yylex();
+       return yylex(YYLEXPARAM);
     }
 
     /* Is there a right-hand side to take care of? */
@@ -1571,8 +1585,12 @@ filter_gets(register SV *sv, register PerlIO *fp, STRLEN append)
       if we already built the token before, use it.
 */
 
-int
-yylex(void)
+int yylex
+#ifdef USE_PURE_BISON
+(YYSTYPE* lvalp, int* lcharp)
+#else
+(void)
+#endif
 {
     dTHR;
     register char *s;
@@ -1582,6 +1600,11 @@ yylex(void)
     GV *gv = Nullgv;
     GV **gvp = 0;
 
+#ifdef USE_PURE_BISON
+    yylval_pointer = lvalp;
+    yychar_pointer = lcharp;
+#endif
+
     /* check if there's an identifier for us to look at */
     if (PL_pending_ident) {
         /* pit holds the identifier we read and pending_ident is reset */
@@ -1719,7 +1742,7 @@ yylex(void)
            if (PL_bufptr != PL_bufend)
                PL_bufptr += 2;
            PL_lex_state = LEX_INTERPCONCAT;
-           return yylex();
+           return yylex(YYLEXPARAM);
        }
        else {
            s = PL_bufptr + 1;
@@ -1763,7 +1786,7 @@ yylex(void)
                Aop(OP_CONCAT);
            }
            else
-               return yylex();
+               return yylex(YYLEXPARAM);
        }
 
     case LEX_INTERPPUSH:
@@ -1796,7 +1819,7 @@ yylex(void)
            s = PL_bufptr;
            Aop(OP_CONCAT);
        }
-       return yylex();
+       return yylex(YYLEXPARAM);
 
     case LEX_INTERPENDMAYBE:
        if (intuit_more(PL_bufptr)) {
@@ -1845,11 +1868,11 @@ yylex(void)
                Aop(OP_CONCAT);
            else {
                PL_bufptr = s;
-               return yylex();
+               return yylex(YYLEXPARAM);
            }
        }
 
-       return yylex();
+       return yylex(YYLEXPARAM);
     case LEX_FORMLINE:
        PL_lex_state = LEX_NORMAL;
        s = scan_formline(PL_bufptr);
@@ -2129,7 +2152,7 @@ yylex(void)
        if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
            PL_bufptr = s;
            PL_lex_state = LEX_FORMLINE;
-           return yylex();
+           return yylex(YYLEXPARAM);
        }
        goto retry;
     case '\r':
@@ -2153,7 +2176,7 @@ yylex(void)
            if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
                PL_bufptr = s;
                PL_lex_state = LEX_FORMLINE;
-               return yylex();
+               return yylex(YYLEXPARAM);
            }
        }
        else {
@@ -2490,7 +2513,7 @@ yylex(void)
                if (PL_lex_fakebrack) {
                    PL_lex_state = LEX_INTERPEND;
                    PL_bufptr = s;
-                   return yylex();             /* ignore fake brackets */
+                   return yylex(YYLEXPARAM);   /* ignore fake brackets */
                }
                if (*s == '-' && s[1] == '>')
                    PL_lex_state = LEX_INTERPENDMAYBE;
@@ -2501,7 +2524,7 @@ yylex(void)
        if (PL_lex_brackets < PL_lex_fakebrack) {
            PL_bufptr = s;
            PL_lex_fakebrack = 0;
-           return yylex();             /* ignore fake brackets */
+           return yylex(YYLEXPARAM);           /* ignore fake brackets */
        }
        force_next('}');
        TOKEN(';');
@@ -3135,8 +3158,11 @@ yylex(void)
                if (*s == '(') {
                    CLINE;
                    if (gv && GvCVu(gv)) {
+                       CV *cv;
+                       if ((cv = GvCV(gv)) && SvPOK(cv))
+                           PL_last_proto = SvPV((SV*)cv, PL_na);
                        for (d = s + 1; *d == ' ' || *d == '\t'; d++) ;
-                       if (*d == ')' && (sv = cv_const_sv(GvCV(gv)))) {
+                       if (*d == ')' && (sv = cv_const_sv(cv))) {
                            s = d + 1;
                            goto its_constant;
                        }
@@ -3145,6 +3171,7 @@ yylex(void)
                    PL_expect = XOPERATOR;
                    force_next(WORD);
                    yylval.ival = 0;
+                   PL_last_lop_op = OP_ENTERSUB;
                    TOKEN('&');
                }
 
@@ -3183,6 +3210,7 @@ yylex(void)
                    /* Resolve to GV now. */
                    op_free(yylval.opval);
                    yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
+                   PL_last_lop_op = OP_ENTERSUB;
                    /* Is there a prototype? */
                    if (SvPOK(cv)) {
                        STRLEN len;
@@ -3209,7 +3237,10 @@ yylex(void)
                    PL_last_lop_op != OP_TRUNCATE &&  /* S/F prototype in opcode.pl */
                    PL_last_lop_op != OP_ACCEPT &&
                    PL_last_lop_op != OP_PIPE_OP &&
-                   PL_last_lop_op != OP_SOCKPAIR)
+                   PL_last_lop_op != OP_SOCKPAIR &&
+                   !(PL_last_lop_op == OP_ENTERSUB 
+                        && PL_last_proto 
+                        && PL_last_proto[PL_last_proto[0] == ';' ? 1 : 0] == '*'))
                {
                    warn(
                     "Bareword \"%s\" not allowed while \"strict subs\" in use",