mirror of
https://github.com/postgres/postgres.git
synced 2025-06-18 00:02:37 -04:00
2fbb286647
Commit 865f14a2d31af23a05bbf2df04c274629c5d5c4d was quite a few bricks shy of a load: psql, ecpg, and plpgsql were all left out-of-step with the core lexer. Of these only the last was likely to be a fatal problem; but still, a minimal amount of grepping, or even just reading the comments adjacent to the places that were changed, would have found the other places that needed to be changed.
673 lines
14 KiB
Perl
673 lines
14 KiB
Perl
#!/usr/bin/perl
|
|
# src/interfaces/ecpg/preproc/parse.pl
|
|
# parser generater for ecpg version 2
|
|
# call with backend parser as stdin
|
|
#
|
|
# Copyright (c) 2007-2015, PostgreSQL Global Development Group
|
|
#
|
|
# Written by Mike Aubury <mike.aubury@aubit.com>
|
|
# Michael Meskes <meskes@postgresql.org>
|
|
# Andy Colson <andy@squeakycode.net>
|
|
#
|
|
# Placed under the same license as PostgreSQL.
|
|
#
|
|
|
|
use strict;
|
|
use warnings;
|
|
no warnings 'uninitialized';
|
|
|
|
my $path = shift @ARGV;
|
|
$path = "." unless $path;
|
|
|
|
my $copymode = 0;
|
|
my $brace_indent = 0;
|
|
my $yaccmode = 0;
|
|
my $header_included = 0;
|
|
my $feature_not_supported = 0;
|
|
my $tokenmode = 0;
|
|
|
|
my (%buff, $infield, $comment, %tokens, %addons);
|
|
my ($stmt_mode, @fields);
|
|
my ($line, $non_term_id);
|
|
|
|
|
|
# some token have to be replaced by other symbols
|
|
# either in the rule
|
|
my %replace_token = (
|
|
'BCONST' => 'ecpg_bconst',
|
|
'FCONST' => 'ecpg_fconst',
|
|
'Sconst' => 'ecpg_sconst',
|
|
'IDENT' => 'ecpg_ident',
|
|
'PARAM' => 'ecpg_param',);
|
|
|
|
# or in the block
|
|
my %replace_string = (
|
|
'NULLS_LA' => 'nulls',
|
|
'WITH_LA' => 'with',
|
|
'TYPECAST' => '::',
|
|
'DOT_DOT' => '..',
|
|
'COLON_EQUALS' => ':=',
|
|
'EQUALS_GREATER' => '=>',);
|
|
|
|
# specific replace_types for specific non-terminals - never include the ':'
|
|
# ECPG-only replace_types are defined in ecpg-replace_types
|
|
my %replace_types = (
|
|
'PrepareStmt' => '<prep>',
|
|
'opt_array_bounds' => '<index>',
|
|
|
|
# "ignore" means: do not create type and rules for this non-term-id
|
|
'stmtblock' => 'ignore',
|
|
'stmtmulti' => 'ignore',
|
|
'CreateAsStmt' => 'ignore',
|
|
'DeallocateStmt' => 'ignore',
|
|
'ColId' => 'ignore',
|
|
'type_function_name' => 'ignore',
|
|
'ColLabel' => 'ignore',
|
|
'Sconst' => 'ignore',);
|
|
|
|
# these replace_line commands excise certain keywords from the core keyword
|
|
# lists. Be sure to account for these in ColLabel and related productions.
|
|
my %replace_line = (
|
|
'unreserved_keywordCONNECTION' => 'ignore',
|
|
'unreserved_keywordCURRENT_P' => 'ignore',
|
|
'unreserved_keywordDAY_P' => 'ignore',
|
|
'unreserved_keywordHOUR_P' => 'ignore',
|
|
'unreserved_keywordINPUT_P' => 'ignore',
|
|
'unreserved_keywordMINUTE_P' => 'ignore',
|
|
'unreserved_keywordMONTH_P' => 'ignore',
|
|
'unreserved_keywordSECOND_P' => 'ignore',
|
|
'unreserved_keywordYEAR_P' => 'ignore',
|
|
'col_name_keywordCHAR_P' => 'ignore',
|
|
'col_name_keywordINT_P' => 'ignore',
|
|
'col_name_keywordVALUES' => 'ignore',
|
|
'reserved_keywordTO' => 'ignore',
|
|
'reserved_keywordUNION' => 'ignore',
|
|
|
|
# some other production rules have to be ignored or replaced
|
|
'fetch_argsFORWARDopt_from_incursor_name' => 'ignore',
|
|
'fetch_argsBACKWARDopt_from_incursor_name' => 'ignore',
|
|
"opt_array_boundsopt_array_bounds'['Iconst']'" => 'ignore',
|
|
'VariableShowStmtSHOWvar_name' => 'SHOW var_name ecpg_into',
|
|
'VariableShowStmtSHOWTIMEZONE' => 'SHOW TIME ZONE ecpg_into',
|
|
'VariableShowStmtSHOWTRANSACTIONISOLATIONLEVEL' =>
|
|
'SHOW TRANSACTION ISOLATION LEVEL ecpg_into',
|
|
'VariableShowStmtSHOWSESSIONAUTHORIZATION' =>
|
|
'SHOW SESSION AUTHORIZATION ecpg_into',
|
|
'returning_clauseRETURNINGtarget_list' =>
|
|
'RETURNING target_list ecpg_into',
|
|
'ExecuteStmtEXECUTEnameexecute_param_clause' =>
|
|
'EXECUTE prepared_name execute_param_clause execute_rest',
|
|
'ExecuteStmtCREATEOptTempTABLEcreate_as_targetASEXECUTEnameexecute_param_clause'
|
|
=> 'CREATE OptTemp TABLE create_as_target AS EXECUTE prepared_name execute_param_clause',
|
|
'PrepareStmtPREPAREnameprep_type_clauseASPreparableStmt' =>
|
|
'PREPARE prepared_name prep_type_clause AS PreparableStmt',
|
|
'var_nameColId' => 'ECPGColId',);
|
|
|
|
preload_addons();
|
|
|
|
main();
|
|
|
|
dump_buffer('header');
|
|
dump_buffer('tokens');
|
|
dump_buffer('types');
|
|
dump_buffer('ecpgtype');
|
|
dump_buffer('orig_tokens');
|
|
print '%%', "\n";
|
|
print 'prog: statements;', "\n";
|
|
dump_buffer('rules');
|
|
include_file('trailer', 'ecpg.trailer');
|
|
dump_buffer('trailer');
|
|
|
|
sub main
|
|
{
|
|
line: while (<>)
|
|
{
|
|
if (/ERRCODE_FEATURE_NOT_SUPPORTED/)
|
|
{
|
|
$feature_not_supported = 1;
|
|
next line;
|
|
}
|
|
|
|
chomp;
|
|
|
|
# comment out the line below to make the result file match (blank line wise)
|
|
# the prior version.
|
|
#next if ($_ eq '');
|
|
|
|
# Dump the action for a rule -
|
|
# stmt_mode indicates if we are processing the 'stmt:'
|
|
# rule (mode==0 means normal, mode==1 means stmt:)
|
|
# flds are the fields to use. These may start with a '$' - in
|
|
# which case they are the result of a previous non-terminal
|
|
#
|
|
# if they dont start with a '$' then they are token name
|
|
#
|
|
# len is the number of fields in flds...
|
|
# leadin is the padding to apply at the beginning (just use for formatting)
|
|
|
|
if (/^%%/)
|
|
{
|
|
$tokenmode = 2;
|
|
$copymode = 1;
|
|
$yaccmode++;
|
|
$infield = 0;
|
|
}
|
|
|
|
my $prec = 0;
|
|
|
|
# Make sure any braces are split
|
|
s/{/ { /g;
|
|
s/}/ } /g;
|
|
|
|
# Any comments are split
|
|
s|\/\*| /* |g;
|
|
s|\*\/| */ |g;
|
|
|
|
# Now split the line into individual fields
|
|
my @arr = split(' ');
|
|
|
|
if ($arr[0] eq '%token' && $tokenmode == 0)
|
|
{
|
|
$tokenmode = 1;
|
|
include_file('tokens', 'ecpg.tokens');
|
|
}
|
|
elsif ($arr[0] eq '%type' && $header_included == 0)
|
|
{
|
|
include_file('header', 'ecpg.header');
|
|
include_file('ecpgtype', 'ecpg.type');
|
|
$header_included = 1;
|
|
}
|
|
|
|
if ($tokenmode == 1)
|
|
{
|
|
my $str = '';
|
|
my $prior = '';
|
|
for my $a (@arr)
|
|
{
|
|
if ($a eq '/*')
|
|
{
|
|
$comment++;
|
|
next;
|
|
}
|
|
if ($a eq '*/')
|
|
{
|
|
$comment--;
|
|
next;
|
|
}
|
|
if ($comment)
|
|
{
|
|
next;
|
|
}
|
|
if (substr($a, 0, 1) eq '<')
|
|
{
|
|
next;
|
|
|
|
# its a type
|
|
}
|
|
$tokens{$a} = 1;
|
|
|
|
$str = $str . ' ' . $a;
|
|
if ($a eq 'IDENT' && $prior eq '%nonassoc')
|
|
{
|
|
|
|
# add two more tokens to the list
|
|
$str = $str . "\n%nonassoc CSTRING\n%nonassoc UIDENT";
|
|
}
|
|
$prior = $a;
|
|
}
|
|
add_to_buffer('orig_tokens', $str);
|
|
next line;
|
|
}
|
|
|
|
# Dont worry about anything if we're not in the right section of gram.y
|
|
if ($yaccmode != 1)
|
|
{
|
|
next line;
|
|
}
|
|
|
|
|
|
# Go through each field in turn
|
|
for (
|
|
my $fieldIndexer = 0;
|
|
$fieldIndexer < scalar(@arr);
|
|
$fieldIndexer++)
|
|
{
|
|
if ($arr[$fieldIndexer] eq '*/' && $comment)
|
|
{
|
|
$comment = 0;
|
|
next;
|
|
}
|
|
elsif ($comment)
|
|
{
|
|
next;
|
|
}
|
|
elsif ($arr[$fieldIndexer] eq '/*')
|
|
{
|
|
|
|
# start of a multiline comment
|
|
$comment = 1;
|
|
next;
|
|
}
|
|
elsif ($arr[$fieldIndexer] eq '//')
|
|
{
|
|
next line;
|
|
}
|
|
elsif ($arr[$fieldIndexer] eq '}')
|
|
{
|
|
$brace_indent--;
|
|
next;
|
|
}
|
|
elsif ($arr[$fieldIndexer] eq '{')
|
|
{
|
|
$brace_indent++;
|
|
next;
|
|
}
|
|
|
|
if ($brace_indent > 0)
|
|
{
|
|
next;
|
|
}
|
|
if ($arr[$fieldIndexer] eq ';')
|
|
{
|
|
if ($copymode)
|
|
{
|
|
if ($infield)
|
|
{
|
|
dump_line($stmt_mode, \@fields);
|
|
}
|
|
add_to_buffer('rules', ";\n\n");
|
|
}
|
|
else
|
|
{
|
|
$copymode = 1;
|
|
}
|
|
@fields = ();
|
|
$infield = 0;
|
|
$line = '';
|
|
next;
|
|
}
|
|
|
|
if ($arr[$fieldIndexer] eq '|')
|
|
{
|
|
if ($copymode)
|
|
{
|
|
if ($infield)
|
|
{
|
|
$infield = $infield + dump_line($stmt_mode, \@fields);
|
|
}
|
|
if ($infield > 1)
|
|
{
|
|
$line = '| ';
|
|
}
|
|
}
|
|
@fields = ();
|
|
next;
|
|
}
|
|
|
|
if (exists $replace_token{ $arr[$fieldIndexer] })
|
|
{
|
|
$arr[$fieldIndexer] = $replace_token{ $arr[$fieldIndexer] };
|
|
}
|
|
|
|
# Are we looking at a declaration of a non-terminal ?
|
|
if (($arr[$fieldIndexer] =~ /[A-Za-z0-9]+:/)
|
|
|| $arr[ $fieldIndexer + 1 ] eq ':')
|
|
{
|
|
$non_term_id = $arr[$fieldIndexer];
|
|
$non_term_id =~ tr/://d;
|
|
|
|
if (not defined $replace_types{$non_term_id})
|
|
{
|
|
$replace_types{$non_term_id} = '<str>';
|
|
$copymode = 1;
|
|
}
|
|
elsif ($replace_types{$non_term_id} eq 'ignore')
|
|
{
|
|
$copymode = 0;
|
|
$line = '';
|
|
next line;
|
|
}
|
|
$line = $line . ' ' . $arr[$fieldIndexer];
|
|
|
|
# Do we have the : attached already ?
|
|
# If yes, we'll have already printed the ':'
|
|
if (!($arr[$fieldIndexer] =~ '[A-Za-z0-9]+:'))
|
|
{
|
|
|
|
# Consume the ':' which is next...
|
|
$line = $line . ':';
|
|
$fieldIndexer++;
|
|
}
|
|
|
|
# Special mode?
|
|
if ($non_term_id eq 'stmt')
|
|
{
|
|
$stmt_mode = 1;
|
|
}
|
|
else
|
|
{
|
|
$stmt_mode = 0;
|
|
}
|
|
my $tstr =
|
|
'%type '
|
|
. $replace_types{$non_term_id} . ' '
|
|
. $non_term_id;
|
|
add_to_buffer('types', $tstr);
|
|
|
|
if ($copymode)
|
|
{
|
|
add_to_buffer('rules', $line);
|
|
}
|
|
$line = '';
|
|
@fields = ();
|
|
$infield = 1;
|
|
next;
|
|
}
|
|
elsif ($copymode)
|
|
{
|
|
$line = $line . ' ' . $arr[$fieldIndexer];
|
|
}
|
|
if ($arr[$fieldIndexer] eq '%prec')
|
|
{
|
|
$prec = 1;
|
|
next;
|
|
}
|
|
|
|
if ( $copymode
|
|
&& !$prec
|
|
&& !$comment
|
|
&& length($arr[$fieldIndexer])
|
|
&& $infield)
|
|
{
|
|
if ($arr[$fieldIndexer] ne 'Op'
|
|
&& ( $tokens{ $arr[$fieldIndexer] } > 0
|
|
|| $arr[$fieldIndexer] =~ /'.+'/)
|
|
|| $stmt_mode == 1)
|
|
{
|
|
my $S;
|
|
if (exists $replace_string{ $arr[$fieldIndexer] })
|
|
{
|
|
$S = $replace_string{ $arr[$fieldIndexer] };
|
|
}
|
|
else
|
|
{
|
|
$S = $arr[$fieldIndexer];
|
|
}
|
|
$S =~ s/_P//g;
|
|
$S =~ tr/'//d;
|
|
if ($stmt_mode == 1)
|
|
{
|
|
push(@fields, $S);
|
|
}
|
|
else
|
|
{
|
|
push(@fields, lc($S));
|
|
}
|
|
}
|
|
else
|
|
{
|
|
push(@fields, '$' . (scalar(@fields) + 1));
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
# append a file onto a buffer.
|
|
# Arguments: buffer_name, filename (without path)
|
|
sub include_file
|
|
{
|
|
my ($buffer, $filename) = @_;
|
|
my $full = "$path/$filename";
|
|
open(my $fh, '<', $full) or die;
|
|
while (<$fh>)
|
|
{
|
|
chomp;
|
|
add_to_buffer($buffer, $_);
|
|
}
|
|
close($fh);
|
|
}
|
|
|
|
sub include_addon
|
|
{
|
|
my ($buffer, $block, $fields, $stmt_mode) = @_;
|
|
my $rec = $addons{$block};
|
|
return 0 unless $rec;
|
|
|
|
if ($rec->{type} eq 'rule')
|
|
{
|
|
dump_fields($stmt_mode, $fields, ' { ');
|
|
}
|
|
elsif ($rec->{type} eq 'addon')
|
|
{
|
|
add_to_buffer('rules', ' { ');
|
|
}
|
|
|
|
#add_to_buffer( $stream, $_ );
|
|
#We have an array to add to the buffer, we'll add it ourself instead of
|
|
#calling add_to_buffer, which does not know about arrays
|
|
|
|
push(@{ $buff{$buffer} }, @{ $rec->{lines} });
|
|
|
|
if ($rec->{type} eq 'addon')
|
|
{
|
|
dump_fields($stmt_mode, $fields, '');
|
|
}
|
|
|
|
|
|
# if we added something (ie there are lines in our array), return 1
|
|
return 1 if (scalar(@{ $rec->{lines} }) > 0);
|
|
return 0;
|
|
}
|
|
|
|
|
|
# include_addon does this same thing, but does not call this
|
|
# sub... so if you change this, you need to fix include_addon too
|
|
# Pass: buffer_name, string_to_append
|
|
sub add_to_buffer
|
|
{
|
|
push(@{ $buff{ $_[0] } }, "$_[1]\n");
|
|
}
|
|
|
|
sub dump_buffer
|
|
{
|
|
my ($buffer) = @_;
|
|
print '/* ', $buffer, ' */', "\n";
|
|
my $ref = $buff{$buffer};
|
|
print @$ref;
|
|
}
|
|
|
|
sub dump_fields
|
|
{
|
|
my ($mode, $flds, $ln) = @_;
|
|
my $len = scalar(@$flds);
|
|
|
|
if ($mode == 0)
|
|
{
|
|
|
|
#Normal
|
|
add_to_buffer('rules', $ln);
|
|
if ($feature_not_supported == 1)
|
|
{
|
|
|
|
# we found an unsupported feature, but we have to
|
|
# filter out ExecuteStmt: CREATE OptTemp TABLE ...
|
|
# because the warning there is only valid in some situations
|
|
if ($flds->[0] ne 'create' || $flds->[2] ne 'table')
|
|
{
|
|
add_to_buffer('rules',
|
|
'mmerror(PARSE_ERROR, ET_WARNING, "unsupported feature will be passed to server");'
|
|
);
|
|
}
|
|
$feature_not_supported = 0;
|
|
}
|
|
|
|
if ($len == 0)
|
|
{
|
|
|
|
# We have no fields ?
|
|
add_to_buffer('rules', ' $$=EMPTY; }');
|
|
}
|
|
else
|
|
{
|
|
|
|
# Go through each field and try to 'aggregate' the tokens
|
|
# into a single 'mm_strdup' where possible
|
|
my @flds_new;
|
|
my $str;
|
|
for (my $z = 0; $z < $len; $z++)
|
|
{
|
|
if (substr($flds->[$z], 0, 1) eq '$')
|
|
{
|
|
push(@flds_new, $flds->[$z]);
|
|
next;
|
|
}
|
|
|
|
$str = $flds->[$z];
|
|
|
|
while (1)
|
|
{
|
|
if ($z >= $len - 1
|
|
|| substr($flds->[ $z + 1 ], 0, 1) eq '$')
|
|
{
|
|
|
|
# We're at the end...
|
|
push(@flds_new, "mm_strdup(\"$str\")");
|
|
last;
|
|
}
|
|
$z++;
|
|
$str = $str . ' ' . $flds->[$z];
|
|
}
|
|
}
|
|
|
|
# So - how many fields did we end up with ?
|
|
$len = scalar(@flds_new);
|
|
if ($len == 1)
|
|
{
|
|
|
|
# Straight assignement
|
|
$str = ' $$ = ' . $flds_new[0] . ';';
|
|
add_to_buffer('rules', $str);
|
|
}
|
|
else
|
|
{
|
|
|
|
# Need to concatenate the results to form
|
|
# our final string
|
|
$str =
|
|
' $$ = cat_str(' . $len . ',' . join(',', @flds_new) . ');';
|
|
add_to_buffer('rules', $str);
|
|
}
|
|
add_to_buffer('rules', '}');
|
|
}
|
|
}
|
|
else
|
|
{
|
|
|
|
# we're in the stmt: rule
|
|
if ($len)
|
|
{
|
|
|
|
# or just the statement ...
|
|
add_to_buffer('rules',
|
|
' { output_statement($1, 0, ECPGst_normal); }');
|
|
}
|
|
else
|
|
{
|
|
add_to_buffer('rules', ' { $$ = NULL; }');
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
sub dump_line
|
|
{
|
|
my ($stmt_mode, $fields) = @_;
|
|
my $block = $non_term_id . $line;
|
|
$block =~ tr/ |//d;
|
|
my $rep = $replace_line{$block};
|
|
if ($rep)
|
|
{
|
|
if ($rep eq 'ignore')
|
|
{
|
|
return 0;
|
|
}
|
|
|
|
if (index($line, '|') != -1)
|
|
{
|
|
$line = '| ' . $rep;
|
|
}
|
|
else
|
|
{
|
|
$line = $rep;
|
|
}
|
|
$block = $non_term_id . $line;
|
|
$block =~ tr/ |//d;
|
|
}
|
|
add_to_buffer('rules', $line);
|
|
my $i = include_addon('rules', $block, $fields, $stmt_mode);
|
|
if ($i == 0)
|
|
{
|
|
dump_fields($stmt_mode, $fields, ' { ');
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
=top
|
|
load addons into cache
|
|
%addons = {
|
|
stmtClosePortalStmt => { 'type' => 'block', 'lines' => [ "{", "if (INFORMIX_MODE)" ..., "}" ] },
|
|
stmtViewStmt => { 'type' => 'rule', 'lines' => [ "| ECPGAllocateDescr", ... ] }
|
|
}
|
|
|
|
=cut
|
|
|
|
sub preload_addons
|
|
{
|
|
my $filename = $path . "/ecpg.addons";
|
|
open(my $fh, '<', $filename) or die;
|
|
|
|
# there may be multple lines starting ECPG: and then multiple lines of code.
|
|
# the code need to be add to all prior ECPG records.
|
|
my (@needsRules, @code, $record);
|
|
|
|
# there may be comments before the first ECPG line, skip them
|
|
my $skip = 1;
|
|
while (<$fh>)
|
|
{
|
|
if (/^ECPG:\s(\S+)\s?(\w+)?/)
|
|
{
|
|
$skip = 0;
|
|
if (@code)
|
|
{
|
|
for my $x (@needsRules)
|
|
{
|
|
push(@{ $x->{lines} }, @code);
|
|
}
|
|
@code = ();
|
|
@needsRules = ();
|
|
}
|
|
$record = {};
|
|
$record->{type} = $2;
|
|
$record->{lines} = [];
|
|
if (exists $addons{$1}) { die "Ga! there are dups!\n"; }
|
|
$addons{$1} = $record;
|
|
push(@needsRules, $record);
|
|
}
|
|
else
|
|
{
|
|
next if $skip;
|
|
push(@code, $_);
|
|
}
|
|
}
|
|
close($fh);
|
|
if (@code)
|
|
{
|
|
for my $x (@needsRules)
|
|
{
|
|
push(@{ $x->{lines} }, @code);
|
|
}
|
|
}
|
|
}
|