yyparse(): extend parser stack before every shift.
authorDavid Mitchell <davem@iabyn.com>
Sat, 10 Dec 2016 20:07:32 +0000 (20:07 +0000)
committerDavid Mitchell <davem@iabyn.com>
Sat, 10 Dec 2016 20:14:57 +0000 (20:14 +0000)
This reverts v5.25.7-60-gb2c9b6e and adds a test.

In that previous commit of mine, for efficiency I changed it so that it
checked and extended the parser stack only after every reduce rather than
every shift, but when it did check, it extended it by at least 15 slots to
allow for all the elements of the longest possible rule to be shifted.

Turns out this was bad reasoning. The following type of code can shift
indefinitely without ever reducing:

    [{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{

parser.h
perly.c
sv.c
t/comp/parser.t
toke.c

index 3c7bb4e..ad148c2 100644 (file)
--- a/parser.h
+++ b/parser.h
@@ -44,9 +44,7 @@ typedef struct yy_parser {
 
     int                    yylen;      /* length of active reduction */
     yy_stack_frame  *stack;    /* base of stack */
-    yy_stack_frame  *stack_maxbase;/* (stack + alloced size - YY_MAXRULE)
-                                    * it's offset by -YY_MAXRULE to make
-                                    * overflow checks quicker */
+    yy_stack_frame  *stack_max1;/* (top-1)th element of allocated stack */
     yy_stack_frame  *ps;       /* current stack frame */
 
     /* lexer state */
diff --git a/perly.c b/perly.c
index 8fc1913..1c018bb 100644 (file)
--- a/perly.c
+++ b/perly.c
@@ -58,15 +58,6 @@ typedef signed char yysigned_char;
 
 # define YYSIZE_T size_t
 
-/* the max number of RHS shifted elements that can make up a rule.
- * This should really be auto-generated from the max value in yyr2[]
- * but that involves extra work, so set it slightly higher than the
- * current max, and assert each time yyr2[] is accessed.
- * Used to determine if the parse stack needs extending.
- */
-
-#define YY_MAXRULE 15
-
 #define YYEOF          0
 #define YYTERROR       1
 
@@ -284,7 +275,7 @@ Perl_yyparse (pTHX_ int gramtype)
     SAVEINT(parser->yyerrstatus);
     SAVEINT(parser->yylen);
     SAVEVPTR(parser->stack);
-    SAVEVPTR(parser->stack_maxbase);
+    SAVEVPTR(parser->stack_max1);
     SAVEVPTR(parser->ps);
 
     /* initialise state for this parse */
@@ -294,7 +285,7 @@ Perl_yyparse (pTHX_ int gramtype)
     parser->yyerrstatus = 0;
     parser->yylen = 0;
     Newx(parser->stack, YYINITDEPTH, yy_stack_frame);
-    parser->stack_maxbase = parser->stack + YYINITDEPTH - YY_MAXRULE;
+    parser->stack_max1 = parser->stack + YYINITDEPTH - 1;
     ps = parser->ps = parser->stack;
     ps->state = 0;
     SAVEDESTRUCTOR_X(S_clear_yystack, parser);
@@ -302,31 +293,33 @@ Perl_yyparse (pTHX_ int gramtype)
     while (1) {
         /* main loop: shift some tokens, then reduce when possible */
 
-        /* grow the stack to accommodate longest possible rule */
-        if (ps >= parser->stack_maxbase) {
-            Size_t pos = ps - parser->stack;
-            Size_t newsize = 2 * (parser->stack_maxbase + YY_MAXRULE
-                                    - parser->stack);
-            /* this will croak on insufficient memory */
-            Renew(parser->stack, newsize, yy_stack_frame);
-            ps = parser->ps = parser->stack + pos;
-            parser->stack_maxbase = parser->stack + newsize - YY_MAXRULE;
-
-            YYDPRINTF((Perl_debug_log,
-                            "parser stack size increased to %lu frames\n",
-                            (unsigned long int)newsize));
-        }
-
         while (1) {
             /* shift a token, or quit when it's possible to reduce */
 
-            assert(ps < parser->stack_maxbase + YY_MAXRULE);
             yystate = ps->state;
 
             YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
 
             parser->yylen = 0;
 
+            /* Grow the stack? We always leave 1 spare slot, in case of a
+             * '' -> 'foo' reduction.
+             * Note that stack_max1 points to the (top-1)th allocated stack
+             * element to make this check faster */
+
+            if (ps >= parser->stack_max1) {
+                Size_t pos = ps - parser->stack;
+                Size_t newsize = 2 * (parser->stack_max1 + 2 - parser->stack);
+                /* this will croak on insufficient memory */
+                Renew(parser->stack, newsize, yy_stack_frame);
+                ps = parser->ps = parser->stack + pos;
+                parser->stack_max1 = parser->stack + newsize - 1;
+
+                YYDPRINTF((Perl_debug_log,
+                                "parser stack size increased to %lu frames\n",
+                                (unsigned long int)newsize));
+            }
+
             /* Do appropriate processing given the current state. Read a
              * lookahead token if we need one and don't already have one.
              * */
@@ -419,7 +412,6 @@ Perl_yyparse (pTHX_ int gramtype)
 
         /* yyn is the number of a rule to reduce with.  */
         parser->yylen = yyr2[yyn];
-        assert(parser->yylen <= YY_MAXRULE); /* see defn of YY_MAXRULE above */
 
         /* If YYLEN is nonzero, implement the default value of the action:
           "$$ = $1".
diff --git a/sv.c b/sv.c
index dc392f0..e915e7d 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -13144,7 +13144,7 @@ Perl_parser_dup(pTHX_ const yy_parser *const proto, CLONE_PARAMS *const param)
     parser->old_parser = NULL;
     parser->stack = NULL;
     parser->ps = NULL;
-    parser->stack_maxbase = NULL;
+    parser->stack_max1 = 0;
     /* XXX parser->stack->state = 0; */
 
     /* XXX eventually, just Copy() most of the parser struct ? */
index b752500..901d66a 100644 (file)
@@ -8,7 +8,7 @@ BEGIN {
     chdir 't' if -d 't';
 }
 
-print "1..186\n";
+print "1..187\n";
 
 sub failed {
     my ($got, $expected, $name) = @_;
@@ -591,6 +591,14 @@ is $@, "", 'substr keys assignment';
         'RT 128952';
 }
 
+# RT #130311: many parser shifts before a reduce
+
+{
+    eval '[' . ('{' x 300);
+    like $@, qr/Missing right curly or square bracket/, 'RT #130311';
+}
+
+
 # Add new tests HERE (above this line)
 
 # bug #74022: Loop on characters in \p{OtherIDContinue}
diff --git a/toke.c b/toke.c
index fd819a9..4ba7337 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -705,7 +705,7 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags)
     PL_parser = parser;
 
     parser->stack = NULL;
-    parser->stack_maxbase = NULL;
+    parser->stack_max1 = NULL;
     parser->ps = NULL;
 
     /* on scope exit, free this parser and restore any outer one */