From: Dave Mitchell <davem@fdisolutions.com>
Date: Sat, 27 May 2006 00:31:33 +0000 (+0000)
Subject: stop OPs leaking in eval "syntax error"
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0539ab63267d5a989c8b513c410c39b33c15aa25;p=p5sagit%2Fp5-mst-13.2.git

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
---

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) {