Run check_keywords.pl anytime gram.c is rebuilt.

This script is a bit slow, but still it only takes a fraction of the time
the bison run does, so the overhead doesn't seem intolerable.  And we
definitely need some mechanical aid here, because people keep missing
the need to add new keywords to the appropriate keyword-list production.

While at it, I moved check_keywords.pl from src/tools into
src/backend/parser where it's actually used, and did some very minor
cleanup on the script.
This commit is contained in:
Tom Lane 2012-09-26 23:10:52 -04:00
parent 10bfe81dee
commit 55c1687a97
2 changed files with 23 additions and 40 deletions

View File

@ -41,6 +41,7 @@ endif
gram.h: gram.c ; gram.h: gram.c ;
gram.c: gram.y gram.c: gram.y
$(PERL) $(srcdir)/check_keywords.pl $< $(top_srcdir)/src/include/parser/kwlist.h
ifdef BISON ifdef BISON
$(BISON) -d $(BISONFLAGS) -o $@ $< $(BISON) -d $(BISONFLAGS) -o $@ $<
else else
@ -65,7 +66,3 @@ gram.o keywords.o parser.o: gram.h
# are not cleaned here. # are not cleaned here.
clean distclean maintainer-clean: clean distclean maintainer-clean:
rm -f lex.backup rm -f lex.backup
maintainer-check:
$(PERL) $(top_srcdir)/src/tools/check_keywords.pl $(top_srcdir)

View File

@ -1,14 +1,18 @@
#!/usr/bin/perl -w #!/usr/bin/perl
# Check that the keyword lists in gram.y and kwlist.h are sane.
# Usage: check_keywords.pl gram.y kwlist.h
# src/backend/parser/check_keywords.pl
# Copyright (c) 2009-2012, PostgreSQL Global Development Group
use warnings;
use strict; use strict;
# Check that the keyword lists in gram.y and kwlist.h are sane. Run from my $gram_filename = $ARGV[0];
# the top directory, or pass a path to a top directory as argument. my $kwlist_filename = $ARGV[1];
#
# src/tools/check_keywords.pl
my $errors = 0; my $errors = 0;
my $path;
sub error(@) sub error(@)
{ {
@ -16,16 +20,6 @@ sub error(@)
$errors = 1; $errors = 1;
} }
if (@ARGV)
{
$path = $ARGV[0];
shift @ARGV;
}
else
{
$path = ".";
}
$, = ' '; # set output field separator $, = ' '; # set output field separator
$\ = "\n"; # set output record separator $\ = "\n"; # set output record separator
@ -35,7 +29,6 @@ $keyword_categories{'col_name_keyword'} = 'COL_NAME_KEYWORD';
$keyword_categories{'type_func_name_keyword'} = 'TYPE_FUNC_NAME_KEYWORD'; $keyword_categories{'type_func_name_keyword'} = 'TYPE_FUNC_NAME_KEYWORD';
$keyword_categories{'reserved_keyword'} = 'RESERVED_KEYWORD'; $keyword_categories{'reserved_keyword'} = 'RESERVED_KEYWORD';
my $gram_filename = "$path/src/backend/parser/gram.y";
open(GRAM, $gram_filename) || die("Could not open : $gram_filename"); open(GRAM, $gram_filename) || die("Could not open : $gram_filename");
my ($S, $s, $k, $n, $kcat); my ($S, $s, $k, $n, $kcat);
@ -59,7 +52,6 @@ line: while (<GRAM>)
if (!($kcat)) if (!($kcat))
{ {
# Is this the beginning of a keyword list? # Is this the beginning of a keyword list?
foreach $k (keys %keyword_categories) foreach $k (keys %keyword_categories)
{ {
@ -89,7 +81,6 @@ line: while (<GRAM>)
} }
elsif ($arr[$fieldIndexer] eq '/*') elsif ($arr[$fieldIndexer] eq '/*')
{ {
# start of a multiline comment # start of a multiline comment
$comment = 1; $comment = 1;
next; next;
@ -101,7 +92,6 @@ line: while (<GRAM>)
if ($arr[$fieldIndexer] eq ';') if ($arr[$fieldIndexer] eq ';')
{ {
# end of keyword list # end of keyword list
$kcat = ''; $kcat = '';
next; next;
@ -118,7 +108,7 @@ line: while (<GRAM>)
} }
close GRAM; close GRAM;
# Check that all keywords are in alphabetical order # Check that each keyword list is in alphabetical order (just for neatnik-ism)
my ($prevkword, $kword, $bare_kword); my ($prevkword, $kword, $bare_kword);
foreach $kcat (keys %keyword_categories) foreach $kcat (keys %keyword_categories)
{ {
@ -126,7 +116,6 @@ foreach $kcat (keys %keyword_categories)
foreach $kword (@{ $keywords{$kcat} }) foreach $kword (@{ $keywords{$kcat} })
{ {
# Some keyword have a _P suffix. Remove it for the comparison. # Some keyword have a _P suffix. Remove it for the comparison.
$bare_kword = $kword; $bare_kword = $kword;
$bare_kword =~ s/_P$//; $bare_kword =~ s/_P$//;
@ -134,30 +123,28 @@ foreach $kcat (keys %keyword_categories)
{ {
error error
"'$bare_kword' after '$prevkword' in $kcat list is misplaced"; "'$bare_kword' after '$prevkword' in $kcat list is misplaced";
$errors = 1;
} }
$prevkword = $bare_kword; $prevkword = $bare_kword;
} }
} }
# Transform the keyword lists into hashes. # Transform the keyword lists into hashes.
# kwhashes is a hash of hashes, keyed by keyword category id, e.g. # kwhashes is a hash of hashes, keyed by keyword category id,
# UNRESERVED_KEYWORD. Each inner hash is a keyed by keyword id, e.g. ABORT_P # e.g. UNRESERVED_KEYWORD.
# with a dummy value. # Each inner hash is keyed by keyword id, e.g. ABORT_P, with a dummy value.
my %kwhashes; my %kwhashes;
while (my ($kcat, $kcat_id) = each(%keyword_categories)) while (my ($kcat, $kcat_id) = each(%keyword_categories))
{ {
@arr = @{ $keywords{$kcat} }; @arr = @{ $keywords{$kcat} };
my $hash; my $hash;
foreach my $item (@arr) { $hash->{$item} = 1 } foreach my $item (@arr) { $hash->{$item} = 1; }
$kwhashes{$kcat_id} = $hash; $kwhashes{$kcat_id} = $hash;
} }
# Now read in kwlist.h # Now read in kwlist.h
my $kwlist_filename = "$path/src/include/parser/kwlist.h";
open(KWLIST, $kwlist_filename) || die("Could not open : $kwlist_filename"); open(KWLIST, $kwlist_filename) || die("Could not open : $kwlist_filename");
my $prevkwstring = ''; my $prevkwstring = '';
@ -173,7 +160,7 @@ kwlist_line: while (<KWLIST>)
my ($kwname) = $2; my ($kwname) = $2;
my ($kwcat_id) = $3; my ($kwcat_id) = $3;
# Check that the list is in alphabetical order # Check that the list is in alphabetical order (critical!)
if ($kwstring le $prevkwstring) if ($kwstring le $prevkwstring)
{ {
error error
@ -182,14 +169,14 @@ kwlist_line: while (<KWLIST>)
$prevkwstring = $kwstring; $prevkwstring = $kwstring;
# Check that the keyword string is valid: all lower-case ASCII chars # Check that the keyword string is valid: all lower-case ASCII chars
if ($kwstring !~ /^[a-z_]*$/) if ($kwstring !~ /^[a-z_]+$/)
{ {
error error
"'$kwstring' is not a valid keyword string, must be all lower-case ASCII chars"; "'$kwstring' is not a valid keyword string, must be all lower-case ASCII chars";
} }
# Check that the keyword name is valid: all upper-case ASCII chars # Check that the keyword name is valid: all upper-case ASCII chars
if ($kwname !~ /^[A-Z_]*$/) if ($kwname !~ /^[A-Z_]+$/)
{ {
error error
"'$kwname' is not a valid keyword name, must be all upper-case ASCII chars"; "'$kwname' is not a valid keyword name, must be all upper-case ASCII chars";
@ -209,8 +196,7 @@ kwlist_line: while (<KWLIST>)
if (!(%kwhash)) if (!(%kwhash))
{ {
error "Unknown keyword category: $kwcat_id";
#error "Unknown kwcat_id: $kwcat_id";
} }
else else
{ {
@ -220,9 +206,9 @@ kwlist_line: while (<KWLIST>)
} }
else else
{ {
# Remove it from the hash, so that we can
# Remove it from the hash, so that we can complain at the end # complain at the end if there's keywords left
# if there's keywords left that were not found in kwlist.h # that were not found in kwlist.h
delete $kwhashes{$kwcat_id}->{$kwname}; delete $kwhashes{$kwcat_id}->{$kwname};
} }
} }