Improve perl style in ecpg's parser-construction scripts.
parse.pl and check_rules.pl used "no warnings 'uninitialized'", which doesn't seem like it measures up to current project standards. Removing that shows that it was hiding various places that accessed off the end of an array, which are easily protected by minor logic adjustments. There's no change in the script results. While here, improve the Makefile rule that invokes these scripts. It neglected to depend on check_rules.pl, so that editing that file didn't result in re-running the check; and it ran check_rules.pl after building preproc.y, so that if check_rules.pl did fail the next "make" attempt would just bypass it. check_rules.pl failures are sufficiently un-heard-of that I don't feel a need to back-patch this. Discussion: https://postgr.es/m/838180.1658181982@sss.pgh.pa.us
This commit is contained in:
parent
d268d0f7a1
commit
0778eb79b1
|
@ -64,9 +64,9 @@ preproc.h: preproc.c
|
||||||
|
|
||||||
preproc.c: BISONFLAGS += -d
|
preproc.c: BISONFLAGS += -d
|
||||||
|
|
||||||
preproc.y: ../../../backend/parser/gram.y parse.pl ecpg.addons ecpg.header ecpg.tokens ecpg.trailer ecpg.type
|
preproc.y: ../../../backend/parser/gram.y parse.pl check_rules.pl ecpg.addons ecpg.header ecpg.tokens ecpg.trailer ecpg.type
|
||||||
$(PERL) $(srcdir)/parse.pl --srcdir $(srcdir) --parser $< --output $@
|
|
||||||
$(PERL) $(srcdir)/check_rules.pl --srcdir $(srcdir) --parser $<
|
$(PERL) $(srcdir)/check_rules.pl --srcdir $(srcdir) --parser $<
|
||||||
|
$(PERL) $(srcdir)/parse.pl --srcdir $(srcdir) --parser $< --output $@
|
||||||
|
|
||||||
# generate keyword headers
|
# generate keyword headers
|
||||||
c_kwlist_d.h: c_kwlist.h $(GEN_KEYWORDLIST_DEPS)
|
c_kwlist_d.h: c_kwlist.h $(GEN_KEYWORDLIST_DEPS)
|
||||||
|
|
|
@ -18,7 +18,6 @@
|
||||||
|
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
no warnings 'uninitialized';
|
|
||||||
use Getopt::Long;
|
use Getopt::Long;
|
||||||
|
|
||||||
my $srcdir = '.';
|
my $srcdir = '.';
|
||||||
|
@ -142,7 +141,8 @@ while (<$parser_fh>)
|
||||||
$in_rule = 0 if $arr[$fieldIndexer] eq ';';
|
$in_rule = 0 if $arr[$fieldIndexer] eq ';';
|
||||||
}
|
}
|
||||||
elsif (($arr[$fieldIndexer] =~ '[A-Za-z0-9]+:')
|
elsif (($arr[$fieldIndexer] =~ '[A-Za-z0-9]+:')
|
||||||
|| $arr[ $fieldIndexer + 1 ] eq ':')
|
|| ( $fieldIndexer + 1 < $n
|
||||||
|
&& $arr[ $fieldIndexer + 1 ] eq ':'))
|
||||||
{
|
{
|
||||||
die "unterminated rule at grammar line $.\n"
|
die "unterminated rule at grammar line $.\n"
|
||||||
if $in_rule;
|
if $in_rule;
|
||||||
|
|
|
@ -14,7 +14,6 @@
|
||||||
|
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
no warnings 'uninitialized';
|
|
||||||
use Getopt::Long;
|
use Getopt::Long;
|
||||||
|
|
||||||
my $srcdir = '.';
|
my $srcdir = '.';
|
||||||
|
@ -40,7 +39,8 @@ my $tokenmode = 0;
|
||||||
|
|
||||||
my (%buff, $infield, $comment, %tokens, %addons);
|
my (%buff, $infield, $comment, %tokens, %addons);
|
||||||
my ($stmt_mode, @fields);
|
my ($stmt_mode, @fields);
|
||||||
my ($line, $non_term_id);
|
my $line = '';
|
||||||
|
my $non_term_id;
|
||||||
|
|
||||||
|
|
||||||
# some token have to be replaced by other symbols
|
# some token have to be replaced by other symbols
|
||||||
|
@ -195,6 +195,16 @@ sub main
|
||||||
# Now split the line into individual fields
|
# Now split the line into individual fields
|
||||||
my @arr = split(' ');
|
my @arr = split(' ');
|
||||||
|
|
||||||
|
if (!@arr)
|
||||||
|
{
|
||||||
|
# empty line: in tokenmode 1, emit an empty line, else ignore
|
||||||
|
if ($tokenmode == 1)
|
||||||
|
{
|
||||||
|
add_to_buffer('orig_tokens', '');
|
||||||
|
}
|
||||||
|
next line;
|
||||||
|
}
|
||||||
|
|
||||||
if ($arr[0] eq '%token' && $tokenmode == 0)
|
if ($arr[0] eq '%token' && $tokenmode == 0)
|
||||||
{
|
{
|
||||||
$tokenmode = 1;
|
$tokenmode = 1;
|
||||||
|
@ -341,7 +351,8 @@ sub main
|
||||||
|
|
||||||
# Are we looking at a declaration of a non-terminal ?
|
# Are we looking at a declaration of a non-terminal ?
|
||||||
if (($arr[$fieldIndexer] =~ /[A-Za-z0-9]+:/)
|
if (($arr[$fieldIndexer] =~ /[A-Za-z0-9]+:/)
|
||||||
|| $arr[ $fieldIndexer + 1 ] eq ':')
|
|| ( $fieldIndexer + 1 < scalar(@arr)
|
||||||
|
&& $arr[ $fieldIndexer + 1 ] eq ':'))
|
||||||
{
|
{
|
||||||
$non_term_id = $arr[$fieldIndexer];
|
$non_term_id = $arr[$fieldIndexer];
|
||||||
$non_term_id =~ tr/://d;
|
$non_term_id =~ tr/://d;
|
||||||
|
@ -409,11 +420,13 @@ sub main
|
||||||
if ( $copymode
|
if ( $copymode
|
||||||
&& !$prec
|
&& !$prec
|
||||||
&& !$comment
|
&& !$comment
|
||||||
|
&& $fieldIndexer < scalar(@arr)
|
||||||
&& length($arr[$fieldIndexer])
|
&& length($arr[$fieldIndexer])
|
||||||
&& $infield)
|
&& $infield)
|
||||||
{
|
{
|
||||||
if ($arr[$fieldIndexer] ne 'Op'
|
if ($arr[$fieldIndexer] ne 'Op'
|
||||||
&& ( $tokens{ $arr[$fieldIndexer] } > 0
|
&& (( defined $tokens{ $arr[$fieldIndexer] }
|
||||||
|
&& $tokens{ $arr[$fieldIndexer] } > 0)
|
||||||
|| $arr[$fieldIndexer] =~ /'.+'/)
|
|| $arr[$fieldIndexer] =~ /'.+'/)
|
||||||
|| $stmt_mode == 1)
|
|| $stmt_mode == 1)
|
||||||
{
|
{
|
||||||
|
@ -472,11 +485,12 @@ sub include_addon
|
||||||
my $rec = $addons{$block};
|
my $rec = $addons{$block};
|
||||||
return 0 unless $rec;
|
return 0 unless $rec;
|
||||||
|
|
||||||
if ($rec->{type} eq 'rule')
|
my $rectype = (defined $rec->{type}) ? $rec->{type} : '';
|
||||||
|
if ($rectype eq 'rule')
|
||||||
{
|
{
|
||||||
dump_fields($stmt_mode, $fields, ' { ');
|
dump_fields($stmt_mode, $fields, ' { ');
|
||||||
}
|
}
|
||||||
elsif ($rec->{type} eq 'addon')
|
elsif ($rectype eq 'addon')
|
||||||
{
|
{
|
||||||
add_to_buffer('rules', ' { ');
|
add_to_buffer('rules', ' { ');
|
||||||
}
|
}
|
||||||
|
@ -487,7 +501,7 @@ sub include_addon
|
||||||
|
|
||||||
push(@{ $buff{$buffer} }, @{ $rec->{lines} });
|
push(@{ $buff{$buffer} }, @{ $rec->{lines} });
|
||||||
|
|
||||||
if ($rec->{type} eq 'addon')
|
if ($rectype eq 'addon')
|
||||||
{
|
{
|
||||||
dump_fields($stmt_mode, $fields, '');
|
dump_fields($stmt_mode, $fields, '');
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in New Issue