1- # !/usr/bin/perl -w
1+ # !/usr/bin/perl
22
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;
310use strict;
411
5- # Check that the keyword lists in gram.y and kwlist.h are sane. Run from
6- # the top directory, or pass a path to a top directory as argument.
7- #
8- # src/tools/check_keywords.pl
12+ my $gram_filename = $ARGV [0];
13+ my $kwlist_filename = $ARGV [1];
914
1015my $errors = 0;
11- my $path ;
1216
1317sub error (@)
1418{
1519 print STDERR @_ ;
1620 $errors = 1;
1721}
1822
19- if (@ARGV )
20- {
21- $path = $ARGV [0];
22- shift @ARGV ;
23- }
24- else
25- {
26- $path = " ." ;
27- }
28-
2923$, = ' ' ; # set output field separator
3024$\ = " \n " ; # set output record separator
3125
3529$keyword_categories {' type_func_name_keyword' } = ' TYPE_FUNC_NAME_KEYWORD' ;
3630$keyword_categories {' reserved_keyword' } = ' RESERVED_KEYWORD' ;
3731
38- my $gram_filename = " $path /src/backend/parser/gram.y" ;
3932open (GRAM, $gram_filename ) || die (" Could not open : $gram_filename " );
4033
4134my ($S , $s , $k , $n , $kcat );
5952
6053 if (!($kcat ))
6154 {
62-
6355 # Is this the beginning of a keyword list?
6456 foreach $k (keys %keyword_categories )
6557 {
8981 }
9082 elsif ($arr [$fieldIndexer ] eq ' /*' )
9183 {
92-
9384 # start of a multiline comment
9485 $comment = 1;
9586 next ;
10192
10293 if ($arr [$fieldIndexer ] eq ' ;' )
10394 {
104-
10595 # end of keyword list
10696 $kcat = ' ' ;
10797 next ;
@@ -118,46 +108,43 @@ (@)
118108}
119109close GRAM;
120110
121- # Check that all keywords are in alphabetical order
111+ # Check that each keyword list is in alphabetical order (just for neatnik-ism)
122112my ($prevkword , $kword , $bare_kword );
123113foreach $kcat (keys %keyword_categories )
124114{
125115 $prevkword = ' ' ;
126116
127117 foreach $kword (@{ $keywords {$kcat } })
128118 {
129-
130119 # Some keyword have a _P suffix. Remove it for the comparison.
131120 $bare_kword = $kword ;
132121 $bare_kword =~ s / _P$// ;
133122 if ($bare_kword le $prevkword )
134123 {
135124 error
136125 " '$bare_kword ' after '$prevkword ' in $kcat list is misplaced" ;
137- $errors = 1;
138126 }
139127 $prevkword = $bare_kword ;
140128 }
141129}
142130
143131# Transform the keyword lists into hashes.
144- # kwhashes is a hash of hashes, keyed by keyword category id, e.g.
145- # UNRESERVED_KEYWORD. Each inner hash is a keyed by keyword id, e.g. ABORT_P
146- # with a dummy value.
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.
147135my %kwhashes ;
148136while (my ($kcat , $kcat_id ) = each (%keyword_categories ))
149137{
150138 @arr = @{ $keywords {$kcat } };
151139
152140 my $hash ;
153- foreach my $item (@arr ) { $hash -> {$item } = 1 }
141+ foreach my $item (@arr ) { $hash -> {$item } = 1; }
154142
155143 $kwhashes {$kcat_id } = $hash ;
156144}
157145
158146# Now read in kwlist.h
159147
160- my $kwlist_filename = " $path /src/include/parser/kwlist.h" ;
161148open (KWLIST, $kwlist_filename ) || die (" Could not open : $kwlist_filename " );
162149
163150my $prevkwstring = ' ' ;
173160 my ($kwname ) = $2 ;
174161 my ($kwcat_id ) = $3 ;
175162
176- # Check that the list is in alphabetical order
163+ # Check that the list is in alphabetical order (critical!)
177164 if ($kwstring le $prevkwstring )
178165 {
179166 error
@@ -182,14 +169,14 @@ (@)
182169 $prevkwstring = $kwstring ;
183170
184171 # Check that the keyword string is valid: all lower-case ASCII chars
185- if ($kwstring !~ / ^[a-z_]* $ / )
172+ if ($kwstring !~ / ^[a-z_]+ $ / )
186173 {
187174 error
188175" '$kwstring ' is not a valid keyword string, must be all lower-case ASCII chars" ;
189176 }
190177
191178 # Check that the keyword name is valid: all upper-case ASCII chars
192- if ($kwname !~ / ^[A-Z_]* $ / )
179+ if ($kwname !~ / ^[A-Z_]+ $ / )
193180 {
194181 error
195182" '$kwname ' is not a valid keyword name, must be all upper-case ASCII chars" ;
209196
210197 if (!(%kwhash ))
211198 {
212-
213- # error "Unknown kwcat_id: $kwcat_id";
199+ error " Unknown keyword category: $kwcat_id " ;
214200 }
215201 else
216202 {
220206 }
221207 else
222208 {
223-
224- # Remove it from the hash, so that we can complain at the end
225- # if there's keywords left that were not found in kwlist.h
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
226212 delete $kwhashes {$kwcat_id }-> {$kwname };
227213 }
228214 }
0 commit comments