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