Improve perl style in ecpg's parser-construction scripts.
authorTom Lane <[email protected]>
Mon, 18 Jul 2022 23:43:16 +0000 (19:43 -0400)
committerTom Lane <[email protected]>
Mon, 18 Jul 2022 23:43:16 +0000 (19:43 -0400)
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

src/interfaces/ecpg/preproc/Makefile
src/interfaces/ecpg/preproc/check_rules.pl
src/interfaces/ecpg/preproc/parse.pl

index ec2359810e59c855a4e4ad7bd07c56d936241cb8..3f33f4638fd7dd3f15cee70973a025f164bd187a 100644 (file)
@@ -64,9 +64,9 @@ preproc.h: preproc.c
 
 preproc.c: BISONFLAGS += -d
 
-preproc.y: ../../../backend/parser/gram.y parse.pl ecpg.addons ecpg.header ecpg.tokens ecpg.trailer ecpg.type
-   $(PERL) $(srcdir)/parse.pl --srcdir $(srcdir) --parser $< --output $@
+preproc.y: ../../../backend/parser/gram.y parse.pl check_rules.pl ecpg.addons ecpg.header ecpg.tokens ecpg.trailer ecpg.type
    $(PERL) $(srcdir)/check_rules.pl --srcdir $(srcdir) --parser $<
+   $(PERL) $(srcdir)/parse.pl --srcdir $(srcdir) --parser $< --output $@
 
 # generate keyword headers
 c_kwlist_d.h: c_kwlist.h $(GEN_KEYWORDLIST_DEPS)
index 58a755f454a940194e035bd6c245f9eafd5f6d3a..23a3741993b8a796abf12176c5df5d26f5783e53 100644 (file)
@@ -18,7 +18,6 @@
 
 use strict;
 use warnings;
-no warnings 'uninitialized';
 use Getopt::Long;
 
 my $srcdir  = '.';
@@ -142,7 +141,8 @@ while (<$parser_fh>)
            $in_rule = 0 if $arr[$fieldIndexer] eq ';';
        }
        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"
              if $in_rule;
index 8fb2224249222692e4fb1d752d803fcd3abb5dc7..8de5c4457b3893904a675937be3f3fa63b175cc9 100644 (file)
@@ -14,7 +14,6 @@
 
 use strict;
 use warnings;
-no warnings 'uninitialized';
 use Getopt::Long;
 
 my $srcdir  = '.';
@@ -40,7 +39,8 @@ my $tokenmode             = 0;
 
 my (%buff, $infield, $comment, %tokens, %addons);
 my ($stmt_mode, @fields);
-my ($line,      $non_term_id);
+my $line = '';
+my $non_term_id;
 
 
 # some token have to be replaced by other symbols
@@ -195,6 +195,16 @@ sub main
        # Now split the line into individual fields
        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)
        {
            $tokenmode = 1;
@@ -341,7 +351,8 @@ sub main
 
            # Are we looking at a declaration of a non-terminal ?
            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 =~ tr/://d;
@@ -409,11 +420,13 @@ sub main
            if (   $copymode
                && !$prec
                && !$comment
+               && $fieldIndexer < scalar(@arr)
                && length($arr[$fieldIndexer])
                && $infield)
            {
                if ($arr[$fieldIndexer] ne 'Op'
-                   && (   $tokens{ $arr[$fieldIndexer] } > 0
+                   && ((   defined $tokens{ $arr[$fieldIndexer] }
+                           && $tokens{ $arr[$fieldIndexer] } > 0)
                        || $arr[$fieldIndexer] =~ /'.+'/)
                    || $stmt_mode == 1)
                {
@@ -472,11 +485,12 @@ sub include_addon
    my $rec = $addons{$block};
    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, ' { ');
    }
-   elsif ($rec->{type} eq 'addon')
+   elsif ($rectype eq 'addon')
    {
        add_to_buffer('rules', ' { ');
    }
@@ -487,7 +501,7 @@ sub include_addon
 
    push(@{ $buff{$buffer} }, @{ $rec->{lines} });
 
-   if ($rec->{type} eq 'addon')
+   if ($rectype eq 'addon')
    {
        dump_fields($stmt_mode, $fields, '');
    }