From 0539ab63267d5a989c8b513c410c39b33c15aa25 Mon Sep 17 00:00:00 2001
From: Dave Mitchell <davem@fdisolutions.com>
Date: Sat, 27 May 2006 00:31:33 +0000
Subject: [PATCH] stop OPs leaking in eval "syntax error" When bison pops
 states during error recovery, any states holding an OP would leak the OP.
 Create an extra YY table that tells us which states are of type opval, and
 when popping one of those, free the op.

p4raw-id: //depot/perl@28315
---
 madly.tab      | 27 +++++++++++++++++++++++++++
 perly.c        |  8 ++++++++
 perly.tab      | 27 +++++++++++++++++++++++++++
 regen_perly.pl | 42 ++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 104 insertions(+)

diff --git a/madly.tab b/madly.tab
index 2718be6..f89e7a3 100644
--- a/madly.tab
+++ b/madly.tab
@@ -876,3 +876,30 @@ static const unsigned char yystos[] =
       60,    96,    96,   105,   105,    99,    96,    88,    96,   108,
      105,     4,   112,   105,   113,    87,    87,    96,    96,   102
 };
+/* which symbols are of type opval */
+static const int yy_is_opval[] =
+{
+  0, 0, 0, 0, 0, 0, 0, 0, 0,
+  0, 0, 0, 0, 1, 1, 1, 1,
+  1, 1, 1, 1, 1, 0,
+  0, 0, 0, 0, 0, 0, 0, 0,
+  0, 0, 0, 0, 0, 0, 0, 0,
+  0, 0, 0, 0, 0, 0, 0, 0,
+  0, 0, 0, 0, 0, 0, 0,
+  0, 0, 0, 0, 0, 0, 0, 0,
+  0, 0, 0, 0, 0, 0, 0, 0,
+  0, 0, 0, 0, 0, 0, 0,
+  0, 0, 0, 0, 0, 0, 0,
+  0, 0, 0, 0, 0, 0, 0, 0,
+  1, 0, 0, 0, 1, 0,
+  0, 1, 1, 1, 1, 1, 1, 1,
+  1, 1, 0, 1, 1, 1, 1, 1,
+  1, 0, 1, 1, 1, 1, 1,
+  1, 0, 0, 0, 1,
+  1, 1, 1, 1, 1, 1, 0,
+  1, 1, 1, 0, 1, 1, 1,
+  1, 1, 1, 1, 1, 1,
+  1, 1, 1, 1, 1, 1, 1,
+  1, 1, 1, 0
+
+};
diff --git a/perly.c b/perly.c
index 18f8606..adf3606 100644
--- a/perly.c
+++ b/perly.c
@@ -613,6 +613,10 @@ Perl_yyparse (pTHX)
 	    /* Pop the rest of the stack.  */
 	    while (yyss < yyssp) {
 		YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
+		if (yy_is_opval[yystos[*yyssp]]) {
+		    YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
+		    op_free(yyvsp->opval);
+		}
 		YYPOPSTACK;
 	    }
 	    YYABORT;
@@ -650,6 +654,10 @@ Perl_yyparse (pTHX)
 	    YYABORT;
 
 	YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
+	if (yy_is_opval[yystos[*yyssp]]) {
+	    YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
+	    op_free(yyvsp->opval);
+	}
 	yyvsp--;
 #ifdef DEBUGGING
 	yynsp--;
diff --git a/perly.tab b/perly.tab
index 18c1624..d1807d7 100644
--- a/perly.tab
+++ b/perly.tab
@@ -884,3 +884,30 @@ static const unsigned char yystos[] =
       96,   105,   105,    99,    96,    78,    96,   108,   105,    81,
      112,   105,   113,    77,    77,    96,    96,   102
 };
+/* which symbols are of type opval */
+static const int yy_is_opval[] =
+{
+  0, 0, 0, 0, 1, 1, 1,
+  1, 1, 1, 1, 1, 1,
+  0, 0, 0, 0, 0, 0, 0, 0,
+  0, 0, 0, 0, 0, 0, 0, 0,
+  0, 0, 0, 0, 0, 0, 0,
+  0, 0, 0, 0, 0, 0, 0,
+  0, 0, 0, 0, 0, 0, 0,
+  0, 0, 0, 0, 0, 0, 0, 0,
+  0, 0, 0, 0, 0, 0, 0,
+  0, 0, 0, 0, 0, 0, 0,
+  0, 0, 0, 0, 0, 0, 0, 0,
+  0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+  0, 0, 1, 0, 0, 0, 1,
+  0, 0, 1, 1, 1, 1, 1,
+  1, 1, 1, 1, 0, 1, 1, 1,
+  1, 1, 1, 0, 0, 0, 1,
+  1, 0, 0, 0, 0,
+  1, 1, 1, 1, 1, 0,
+  0, 0, 1, 1, 1, 0, 1, 1,
+  1, 1, 1, 1, 1, 1,
+  1, 1, 1, 1, 1, 1,
+  1, 1, 1, 1, 1, 0
+
+};
diff --git a/regen_perly.pl b/regen_perly.pl
index af92aa8..95e209b 100644
--- a/regen_perly.pl
+++ b/regen_perly.pl
@@ -11,6 +11,7 @@
 #		#line directives plus adding a #ifdef PERL_CORE
 #
 # perly.tab	the parser table C definitions extracted from the bison output
+#		plus an extra table generated by this script.
 #
 # perly.act	the action case statements extracted from the bison output
 #
@@ -87,6 +88,8 @@ close CTMPFILE;
 
 my ($actlines, $tablines) = extract($clines);
 
+$tablines .= make_opval_tab($y_file, $tablines);
+
 chmod 0644, $act_file;
 open ACTFILE, ">$act_file" or die "can't open $act_file: $!\n";
 print ACTFILE $actlines;
@@ -169,6 +172,45 @@ sub extract {
     return $actlines. "\n", $tablines. "\n";
 }
 
+# read a .y file and extract a list of all the token names and
+# non-terminal names that are declared to be of type opval
+# then scan the string $tablines for the table yytname which gives
+# the token index of each token/non-terminal, then use this to
+# create a new table, indexed by token number, which indicates
+# whether that token is of type opval.
+#
+# ie given
+# %token <opval> A B
+# %type  <opval> C D
+#
+# and yytname[] = { "A" "B", "C", "D", "E", "F" };
+#
+# then return
+# static const int yy_is_opval[] = { 1, 1, 1, 1, 0, 0 }
+
+sub make_opval_tab {
+    my ($y_file, $tablines) = @_;
+    my %tokens;
+    open my $fh, '<', $y_file or die "Can't open $y_file: $!\n";
+    while (<$fh>) {
+	next unless s/^%(token|type)\s+<opval>\s+//;
+	$tokens{$_} =1 for (split ' ', $_);
+    }
+
+    $tablines =~ /^\Qstatic const char *const yytname[] =\E\n
+	    {\n
+	    (.*?)
+	    ^};
+	    /xsm
+	or die "Can't extract yytname[] from table string\n";
+    my $fields = $1;
+    $fields =~ s/"([^"]+)"/$tokens{$1}||0/ge;
+    return 
+	"/* which symbols are of type opval */\n" .
+	"static const int yy_is_opval[] =\n{\n" . $fields . "\n};\n";
+}
+
+
 sub my_system {
     system(@_);
     if ($? == -1) {
-- 
2.7.4