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