aboutsummaryrefslogtreecommitdiff
path: root/src/interfaces/ecpg/preproc/parse.pl
diff options
context:
space:
mode:
Diffstat (limited to 'src/interfaces/ecpg/preproc/parse.pl')
-rw-r--r--src/interfaces/ecpg/preproc/parse.pl374
1 files changed, 200 insertions, 174 deletions
diff --git a/src/interfaces/ecpg/preproc/parse.pl b/src/interfaces/ecpg/preproc/parse.pl
index 0e7bc5eecc0..c772b2ac95a 100644
--- a/src/interfaces/ecpg/preproc/parse.pl
+++ b/src/interfaces/ecpg/preproc/parse.pl
@@ -7,7 +7,7 @@
#
# Written by Mike Aubury <mike.aubury@aubit.com>
# Michael Meskes <meskes@postgresql.org>
-# Andy Colson <andy@squeakycode.net>
+# Andy Colson <andy@squeakycode.net>
#
# Placed under the same license as PostgreSQL.
#
@@ -26,9 +26,9 @@ 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);
+my (%buff, $infield, $comment, %tokens, %addons);
+my ($stmt_mode, @fields);
+my ($line, $non_term_id);
# some token have to be replaced by other symbols
@@ -38,8 +38,7 @@ my %replace_token = (
'FCONST' => 'ecpg_fconst',
'Sconst' => 'ecpg_sconst',
'IDENT' => 'ecpg_ident',
- 'PARAM' => 'ecpg_param',
-);
+ 'PARAM' => 'ecpg_param',);
# or in the block
my %replace_string = (
@@ -48,8 +47,7 @@ my %replace_string = (
'NULLS_LAST' => 'nulls last',
'TYPECAST' => '::',
'DOT_DOT' => '..',
- 'COLON_EQUALS' => ':=',
-);
+ 'COLON_EQUALS' => ':=',);
# specific replace_types for specific non-terminals - never include the ':'
# ECPG-only replace_types are defined in ecpg-replace_types
@@ -65,8 +63,7 @@ my %replace_types = (
'ColId' => 'ignore',
'type_function_name' => 'ignore',
'ColLabel' => 'ignore',
- 'Sconst' => '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.
@@ -90,18 +87,21 @@ my %replace_line = (
'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',
+ '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',
-);
+ '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();
@@ -112,44 +112,45 @@ dump_buffer('tokens');
dump_buffer('types');
dump_buffer('ecpgtype');
dump_buffer('orig_tokens');
-print '%%', "\n";
+print '%%', "\n";
print 'prog: statements;', "\n";
dump_buffer('rules');
-include_file( 'trailer', 'ecpg.trailer' );
+include_file('trailer', 'ecpg.trailer');
dump_buffer('trailer');
sub main
{
- line: while (<>)
+ line: while (<>)
{
- if (/ERRCODE_FEATURE_NOT_SUPPORTED/)
+ 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 (/^%%/) {
+ 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;
+ $infield = 0;
}
my $prec = 0;
@@ -165,130 +166,136 @@ sub main
# Now split the line into individual fields
my @arr = split(' ');
- if ( $arr[0] eq '%token' && $tokenmode == 0 )
+ if ($arr[0] eq '%token' && $tokenmode == 0)
{
$tokenmode = 1;
- include_file( 'tokens', 'ecpg.tokens' );
+ include_file('tokens', 'ecpg.tokens');
}
- elsif ( $arr[0] eq '%type' && $header_included == 0 )
+ elsif ($arr[0] eq '%type' && $header_included == 0)
{
- include_file( 'header', 'ecpg.header' );
- include_file( 'ecpgtype', 'ecpg.type' );
+ include_file('header', 'ecpg.header');
+ include_file('ecpgtype', 'ecpg.type');
$header_included = 1;
}
- if ( $tokenmode == 1 )
+ if ($tokenmode == 1)
{
- my $str = '';
+ my $str = '';
my $prior = '';
for my $a (@arr)
{
- if ( $a eq '/*' )
+ if ($a eq '/*')
{
$comment++;
next;
}
- if ( $a eq '*/' )
+ if ($a eq '*/')
{
$comment--;
next;
}
- if ($comment)
+ if ($comment)
{
next;
}
- if ( substr( $a, 0, 1 ) eq '<' ) {
+ if (substr($a, 0, 1) eq '<')
+ {
next;
# its a type
}
- $tokens{ $a } = 1;
+ $tokens{$a} = 1;
$str = $str . ' ' . $a;
- if ( $a eq 'IDENT' && $prior eq '%nonassoc' )
+ 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 );
+ 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 )
+ # 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++ )
+ for (
+ my $fieldIndexer = 0;
+ $fieldIndexer < scalar(@arr);
+ $fieldIndexer++)
{
- if ( $arr[$fieldIndexer] eq '*/' && $comment )
+ if ($arr[$fieldIndexer] eq '*/' && $comment)
{
$comment = 0;
next;
}
- elsif ($comment)
+ elsif ($comment)
{
next;
}
- elsif ( $arr[$fieldIndexer] eq '/*' )
+ elsif ($arr[$fieldIndexer] eq '/*')
{
+
# start of a multiline comment
$comment = 1;
next;
}
- elsif ( $arr[$fieldIndexer] eq '//' )
+ elsif ($arr[$fieldIndexer] eq '//')
{
next line;
}
- elsif ( $arr[$fieldIndexer] eq '}' )
+ elsif ($arr[$fieldIndexer] eq '}')
{
$brace_indent--;
next;
}
- elsif ( $arr[$fieldIndexer] eq '{' )
+ elsif ($arr[$fieldIndexer] eq '{')
{
$brace_indent++;
next;
}
- if ( $brace_indent > 0 )
+ if ($brace_indent > 0)
{
next;
}
- if ( $arr[$fieldIndexer] eq ';' )
+ if ($arr[$fieldIndexer] eq ';')
{
- if ($copymode)
+ if ($copymode)
{
- if ( $infield )
+ if ($infield)
{
- dump_line( $stmt_mode, \@fields );
+ dump_line($stmt_mode, \@fields);
}
- add_to_buffer( 'rules', ";\n\n" );
+ add_to_buffer('rules', ";\n\n");
}
- else
+ else
{
$copymode = 1;
}
- @fields = ();
- $infield = 0;
- $line = '';
+ @fields = ();
+ $infield = 0;
+ $line = '';
next;
}
- if ( $arr[$fieldIndexer] eq '|' )
+ if ($arr[$fieldIndexer] eq '|')
{
- if ($copymode)
+ if ($copymode)
{
- if ( $infield )
+ if ($infield)
{
- $infield = $infield + dump_line( $stmt_mode, \@fields );
+ $infield = $infield + dump_line($stmt_mode, \@fields);
}
- if ( $infield > 1 )
+ if ($infield > 1)
{
$line = '| ';
}
@@ -297,24 +304,24 @@ sub main
next;
}
- if ( exists $replace_token{ $arr[$fieldIndexer] } )
+ 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 ':' )
+ 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} )
+ if (not defined $replace_types{$non_term_id})
{
$replace_types{$non_term_id} = '<str>';
$copymode = 1;
}
- elsif ( $replace_types{$non_term_id} eq 'ignore' )
+ elsif ($replace_types{$non_term_id} eq 'ignore')
{
$copymode = 0;
$line = '';
@@ -324,38 +331,43 @@ sub main
# Do we have the : attached already ?
# If yes, we'll have already printed the ':'
- if ( !( $arr[$fieldIndexer] =~ '[A-Za-z0-9]+:' ) )
+ if (!($arr[$fieldIndexer] =~ '[A-Za-z0-9]+:'))
{
+
# Consume the ':' which is next...
$line = $line . ':';
$fieldIndexer++;
}
# Special mode?
- if ( $non_term_id eq 'stmt' )
+ if ($non_term_id eq 'stmt')
{
$stmt_mode = 1;
}
- else
+ else
{
$stmt_mode = 0;
}
- my $tstr = '%type ' . $replace_types{$non_term_id} . ' ' . $non_term_id;
- add_to_buffer( 'types', $tstr );
+ my $tstr =
+ '%type '
+ . $replace_types{$non_term_id} . ' '
+ . $non_term_id;
+ add_to_buffer('types', $tstr);
- if ($copymode)
+ if ($copymode)
{
- add_to_buffer( 'rules', $line );
+ add_to_buffer('rules', $line);
}
- $line = '';
- @fields = ();
- $infield = 1;
+ $line = '';
+ @fields = ();
+ $infield = 1;
next;
}
- elsif ($copymode) {
+ elsif ($copymode)
+ {
$line = $line . ' ' . $arr[$fieldIndexer];
}
- if ( $arr[$fieldIndexer] eq '%prec' )
+ if ($arr[$fieldIndexer] eq '%prec')
{
$prec = 1;
next;
@@ -364,38 +376,37 @@ sub main
if ( $copymode
&& !$prec
&& !$comment
- && length( $arr[$fieldIndexer] )
- && $infield )
+ && length($arr[$fieldIndexer])
+ && $infield)
{
- if (
- $arr[$fieldIndexer] ne 'Op'
- && ( $tokens{ $arr[$fieldIndexer] } > 0 || $arr[$fieldIndexer] =~ /'.+'/ )
- || $stmt_mode == 1
- )
+ if ($arr[$fieldIndexer] ne 'Op'
+ && ( $tokens{ $arr[$fieldIndexer] } > 0
+ || $arr[$fieldIndexer] =~ /'.+'/)
+ || $stmt_mode == 1)
{
my $S;
- if ( exists $replace_string{ $arr[$fieldIndexer] } )
+ if (exists $replace_string{ $arr[$fieldIndexer] })
{
$S = $replace_string{ $arr[$fieldIndexer] };
}
- else
+ else
{
$S = $arr[$fieldIndexer];
}
$S =~ s/_P//g;
$S =~ tr/'//d;
- if ( $stmt_mode == 1 )
+ if ($stmt_mode == 1)
{
push(@fields, $S);
}
- else
+ else
{
push(@fields, lc($S));
}
}
- else
+ else
{
- push(@fields, '$' . (scalar(@fields)+1));
+ push(@fields, '$' . (scalar(@fields) + 1));
}
}
}
@@ -405,43 +416,43 @@ sub main
# append a file onto a buffer.
# Arguments: buffer_name, filename (without path)
-sub include_file
+sub include_file
{
my ($buffer, $filename) = @_;
my $full = "$path/$filename";
open(my $fh, '<', $full) or die;
- while ( <$fh> )
+ while (<$fh>)
{
chomp;
- add_to_buffer( $buffer, $_ );
+ add_to_buffer($buffer, $_);
}
close($fh);
}
sub include_addon
{
- my($buffer, $block, $fields, $stmt_mode) = @_;
+ my ($buffer, $block, $fields, $stmt_mode) = @_;
my $rec = $addons{$block};
return 0 unless $rec;
-
- if ( $rec->{type} eq 'rule' )
+
+ if ($rec->{type} eq 'rule')
{
- dump_fields( $stmt_mode, $fields, ' { ' );
+ dump_fields($stmt_mode, $fields, ' { ');
}
- elsif ( $rec->{type} eq 'addon' )
+ elsif ($rec->{type} eq 'addon')
{
- add_to_buffer( 'rules', ' { ' );
+ add_to_buffer('rules', ' { ');
}
#add_to_buffer( $stream, $_ );
- #We have an array to add to the buffer, we'll add it ourself instead of
+ #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' )
+ push(@{ $buff{$buffer} }, @{ $rec->{lines} });
+
+ if ($rec->{type} eq 'addon')
{
- dump_fields( $stmt_mode, $fields, '' );
+ dump_fields($stmt_mode, $fields, '');
}
@@ -454,56 +465,60 @@ sub include_addon
# 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
+sub add_to_buffer
{
- push( @{ $buff{$_[0]} }, "$_[1]\n" );
+ push(@{ $buff{ $_[0] } }, "$_[1]\n");
}
-sub dump_buffer
+sub dump_buffer
{
- my($buffer) = @_;
- print '/* ', $buffer, ' */',"\n";
+ my ($buffer) = @_;
+ print '/* ', $buffer, ' */', "\n";
my $ref = $buff{$buffer};
print @$ref;
}
-sub dump_fields
+sub dump_fields
{
- my ( $mode, $flds, $ln ) = @_;
+ my ($mode, $flds, $ln) = @_;
my $len = scalar(@$flds);
- if ( $mode == 0 )
+ if ($mode == 0)
{
+
#Normal
- add_to_buffer( 'rules', $ln );
- if ( $feature_not_supported == 1 )
+ 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' )
+ 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");'
+ add_to_buffer('rules',
+'mmerror(PARSE_ERROR, ET_WARNING, "unsupported feature will be passed to server");'
);
}
$feature_not_supported = 0;
}
- if ( $len == 0 )
+ if ($len == 0)
{
+
# We have no fields ?
- add_to_buffer( 'rules', ' $$=EMPTY; }' );
- }
- else
+ add_to_buffer('rules', ' $$=EMPTY; }');
+ }
+ else
{
- # Go through each field and try to 'aggregate' the tokens
+
+ # 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++ )
+ for (my $z = 0; $z < $len; $z++)
{
- if ( substr( $flds->[$z], 0, 1 ) eq '$' )
+ if (substr($flds->[$z], 0, 1) eq '$')
{
push(@flds_new, $flds->[$z]);
next;
@@ -511,12 +526,14 @@ sub dump_fields
$str = $flds->[$z];
- while (1)
+ while (1)
{
- if ( $z >= $len - 1 || substr( $flds->[ $z + 1 ], 0, 1 ) eq '$' )
+ if ($z >= $len - 1
+ || substr($flds->[ $z + 1 ], 0, 1) eq '$')
{
+
# We're at the end...
- push(@flds_new, "mm_strdup(\"$str\")");
+ push(@flds_new, "mm_strdup(\"$str\")");
last;
}
$z++;
@@ -526,67 +543,73 @@ sub dump_fields
# So - how many fields did we end up with ?
$len = scalar(@flds_new);
- if ( $len == 1 )
+ if ($len == 1)
{
+
# Straight assignement
$str = ' $$ = ' . $flds_new[0] . ';';
- add_to_buffer( 'rules', $str );
+ add_to_buffer('rules', $str);
}
- else
+ else
{
+
# Need to concatenate the results to form
# our final string
- $str = ' $$ = cat_str(' . $len . ',' . join(',', @flds_new) . ');';
- add_to_buffer( 'rules', $str );
+ $str =
+ ' $$ = cat_str(' . $len . ',' . join(',', @flds_new) . ');';
+ add_to_buffer('rules', $str);
}
- add_to_buffer( 'rules', '}' );
+ 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); }' );
+ add_to_buffer('rules',
+ ' { output_statement($1, 0, ECPGst_normal); }');
}
else
{
- add_to_buffer( 'rules', ' { $$ = NULL; }' );
+ add_to_buffer('rules', ' { $$ = NULL; }');
}
}
}
-sub dump_line
+sub dump_line
{
- my($stmt_mode, $fields) = @_;
+ my ($stmt_mode, $fields) = @_;
my $block = $non_term_id . $line;
$block =~ tr/ |//d;
my $rep = $replace_line{$block};
if ($rep)
{
- if ($rep eq 'ignore' )
+ if ($rep eq 'ignore')
{
return 0;
}
- if ( index( $line, '|' ) != -1 )
+ if (index($line, '|') != -1)
{
$line = '| ' . $rep;
}
- else
+ 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 )
+ add_to_buffer('rules', $line);
+ my $i = include_addon('rules', $block, $fields, $stmt_mode);
+ if ($i == 0)
{
- dump_fields( $stmt_mode, $fields, ' { ' );
+ dump_fields($stmt_mode, $fields, ' { ');
}
return 1;
}
@@ -599,16 +622,19 @@ sub dump_line
}
=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.
+
+ # 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> )
+ while (<$fh>)
{
if (/^ECPG:\s(\S+)\s?(\w+)?/)
{
@@ -619,16 +645,16 @@ sub preload_addons
{
push(@{ $x->{lines} }, @code);
}
- @code = ();
+ @code = ();
@needsRules = ();
}
- $record = {};
- $record->{type} = $2;
+ $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;
generated by cgit v1.2.3 (git 2.25.1) at 2025-08-04 14:49:49 +0000