granicus.if.org Git - postgresql/blob - src/backend/parser/check_keywords.pl

   1 #!/usr/bin/perl
   2
   3 # Check that the keyword lists in gram.y and kwlist.h are sane.
   4 # Usage: check_keywords.pl gram.y kwlist.h
   5
   6 # src/backend/parser/check_keywords.pl
   7 # Copyright (c) 2009-2018, PostgreSQL Global Development Group
   8
   9 use warnings;
  10 use strict;
  11
  12 my $gram_filename   = $ARGV[0];
  13 my $kwlist_filename = $ARGV[1];
  14
  15 my $errors = 0;
  16
  17 sub error
  18 {
  19         print STDERR @_;
  20         $errors = 1;
  21 }
  22
  23 $, = ' ';     # set output field separator
  24 $\ = "\n";    # set output record separator
  25
  26 my %keyword_categories;
  27 $keyword_categories{'unreserved_keyword'}     = 'UNRESERVED_KEYWORD';
  28 $keyword_categories{'col_name_keyword'}       = 'COL_NAME_KEYWORD';
  29 $keyword_categories{'type_func_name_keyword'} = 'TYPE_FUNC_NAME_KEYWORD';
  30 $keyword_categories{'reserved_keyword'}       = 'RESERVED_KEYWORD';
  31
  32 open(my $gram, '<', $gram_filename) || die("Could not open : $gram_filename");
  33
  34 my $kcat;
  35 my $comment;
  36 my @arr;
  37 my %keywords;
  38
  39 line: while (my $S = <$gram>)
  40 {
  41         chomp $S;    # strip record separator
  42
  43         my $s;
  44
  45         # Make sure any braces are split
  46         $s = '{', $S =~ s/$s/ { /g;
  47         $s = '}', $S =~ s/$s/ } /g;
  48
  49         # Any comments are split
  50         $s = '[/][*]', $S =~ s#$s# /* #g;
  51         $s = '[*][/]', $S =~ s#$s# */ #g;
  52
  53         if (!($kcat))
  54         {
  55
  56                 # Is this the beginning of a keyword list?
  57                 foreach my $k (keys %keyword_categories)
  58                 {
  59                         if ($S =~ m/^($k):/)
  60                         {
  61                                 $kcat = $k;
  62                                 next line;
  63                         }
  64                 }
  65                 next line;
  66         }
  67
  68         # Now split the line into individual fields
  69         my $n = (@arr = split(' ', $S));
  70
  71         # Ok, we're in a keyword list. Go through each field in turn
  72         for (my $fieldIndexer = 0; $fieldIndexer < $n; $fieldIndexer++)
  73         {
  74                 if ($arr[$fieldIndexer] eq '*/' && $comment)
  75                 {
  76                         $comment = 0;
  77                         next;
  78                 }
  79                 elsif ($comment)
  80                 {
  81                         next;
  82                 }
  83                 elsif ($arr[$fieldIndexer] eq '/*')
  84                 {
  85
  86                         # start of a multiline comment
  87                         $comment = 1;
  88                         next;
  89                 }
  90                 elsif ($arr[$fieldIndexer] eq '//')
  91                 {
  92                         next line;
  93                 }
  94
  95                 if ($arr[$fieldIndexer] eq ';')
  96                 {
  97
  98                         # end of keyword list
  99                         $kcat = '';
 100                         next;
 101                 }
 102
 103                 if ($arr[$fieldIndexer] eq '|')
 104                 {
 105                         next;
 106                 }
 107
 108                 # Put this keyword into the right list
 109                 push @{ $keywords{$kcat} }, $arr[$fieldIndexer];
 110         }
 111 }
 112 close $gram;
 113
 114 # Check that each keyword list is in alphabetical order (just for neatnik-ism)
 115 my ($prevkword, $bare_kword);
 116 foreach my $kcat (keys %keyword_categories)
 117 {
 118         $prevkword = '';
 119
 120         foreach my $kword (@{ $keywords{$kcat} })
 121         {
 122
 123                 # Some keyword have a _P suffix. Remove it for the comparison.
 124                 $bare_kword = $kword;
 125                 $bare_kword =~ s/_P$//;
 126                 if ($bare_kword le $prevkword)
 127                 {
 128                         error
 129                           "'$bare_kword' after '$prevkword' in $kcat list is misplaced";
 130                 }
 131                 $prevkword = $bare_kword;
 132         }
 133 }
 134
 135 # Transform the keyword lists into hashes.
 136 # kwhashes is a hash of hashes, keyed by keyword category id,
 137 # e.g. UNRESERVED_KEYWORD.
 138 # Each inner hash is keyed by keyword id, e.g. ABORT_P, with a dummy value.
 139 my %kwhashes;
 140 while (my ($kcat, $kcat_id) = each(%keyword_categories))
 141 {
 142         @arr = @{ $keywords{$kcat} };
 143
 144         my $hash;
 145         foreach my $item (@arr) { $hash->{$item} = 1; }
 146
 147         $kwhashes{$kcat_id} = $hash;
 148 }
 149
 150 # Now read in kwlist.h
 151
 152 open(my $kwlist, '<', $kwlist_filename)
 153   || die("Could not open : $kwlist_filename");
 154
 155 my $prevkwstring = '';
 156 my $bare_kwname;
 157 my %kwhash;
 158 kwlist_line: while (<$kwlist>)
 159 {
 160         my ($line) = $_;
 161
 162         if ($line =~ /^PG_KEYWORD\(\"(.*)\", (.*), (.*)\)/)
 163         {
 164                 my ($kwstring) = $1;
 165                 my ($kwname)   = $2;
 166                 my ($kwcat_id) = $3;
 167
 168                 # Check that the list is in alphabetical order (critical!)
 169                 if ($kwstring le $prevkwstring)
 170                 {
 171                         error
 172                           "'$kwstring' after '$prevkwstring' in kwlist.h is misplaced";
 173                 }
 174                 $prevkwstring = $kwstring;
 175
 176                 # Check that the keyword string is valid: all lower-case ASCII chars
 177                 if ($kwstring !~ /^[a-z_]+$/)
 178                 {
 179                         error
 180                           "'$kwstring' is not a valid keyword string, must be all lower-case ASCII chars";
 181                 }
 182
 183                 # Check that the keyword name is valid: all upper-case ASCII chars
 184                 if ($kwname !~ /^[A-Z_]+$/)
 185                 {
 186                         error
 187                           "'$kwname' is not a valid keyword name, must be all upper-case ASCII chars";
 188                 }
 189
 190                 # Check that the keyword string matches keyword name
 191                 $bare_kwname = $kwname;
 192                 $bare_kwname =~ s/_P$//;
 193                 if ($bare_kwname ne uc($kwstring))
 194                 {
 195                         error
 196                           "keyword name '$kwname' doesn't match keyword string '$kwstring'";
 197                 }
 198
 199                 # Check that the keyword is present in the grammar
 200                 %kwhash = %{ $kwhashes{$kwcat_id} };
 201
 202                 if (!(%kwhash))
 203                 {
 204                         error "Unknown keyword category: $kwcat_id";
 205                 }
 206                 else
 207                 {
 208                         if (!($kwhash{$kwname}))
 209                         {
 210                                 error "'$kwname' not present in $kwcat_id section of gram.y";
 211                         }
 212                         else
 213                         {
 214
 215                                 # Remove it from the hash, so that we can
 216                                 # complain at the end if there's keywords left
 217                                 # that were not found in kwlist.h
 218                                 delete $kwhashes{$kwcat_id}->{$kwname};
 219                         }
 220                 }
 221         }
 222 }
 223 close $kwlist;
 224
 225 # Check that we've paired up all keywords from gram.y with lines in kwlist.h
 226 while (my ($kwcat, $kwcat_id) = each(%keyword_categories))
 227 {
 228         %kwhash = %{ $kwhashes{$kwcat_id} };
 229
 230         for my $kw (keys %kwhash)
 231         {
 232                 error "'$kw' found in gram.y $kwcat category, but not in kwlist.h";
 233         }
 234 }
 235
 236 exit $errors;