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

1 files changed, 42 insertions, 0 deletions

diff --git a/regen_perly.pl b/regen_perly.pl
index af92aa890c..95e209bc6c 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) {