2012-09-27 05:10:52 +02:00
|
|
|
#!/usr/bin/perl
|
2009-04-30 12:26:35 +02:00
|
|
|
|
2012-09-27 05:10:52 +02:00
|
|
|
# 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
|
2017-01-03 19:48:53 +01:00
|
|
|
# Copyright (c) 2009-2017, PostgreSQL Global Development Group
|
2012-09-27 05:10:52 +02:00
|
|
|
|
|
|
|
use warnings;
|
2009-04-30 12:26:35 +02:00
|
|
|
use strict;
|
2009-04-29 07:05:57 +02:00
|
|
|
|
2013-05-29 22:58:43 +02:00
|
|
|
my $gram_filename = $ARGV[0];
|
2012-09-27 05:10:52 +02:00
|
|
|
my $kwlist_filename = $ARGV[1];
|
2009-04-30 12:26:35 +02:00
|
|
|
|
2012-02-27 12:53:12 +01:00
|
|
|
my $errors = 0;
|
2009-04-29 07:05:57 +02:00
|
|
|
|
2017-03-27 04:24:13 +02:00
|
|
|
sub error
|
2012-07-05 03:47:49 +02:00
|
|
|
{
|
|
|
|
print STDERR @_;
|
|
|
|
$errors = 1;
|
2012-02-27 12:53:12 +01:00
|
|
|
}
|
|
|
|
|
2012-07-05 03:47:49 +02:00
|
|
|
$, = ' '; # set output field separator
|
|
|
|
$\ = "\n"; # set output record separator
|
2009-04-29 07:05:57 +02:00
|
|
|
|
2009-04-30 12:26:35 +02:00
|
|
|
my %keyword_categories;
|
2012-07-05 03:47:49 +02:00
|
|
|
$keyword_categories{'unreserved_keyword'} = 'UNRESERVED_KEYWORD';
|
|
|
|
$keyword_categories{'col_name_keyword'} = 'COL_NAME_KEYWORD';
|
2009-04-29 07:05:57 +02:00
|
|
|
$keyword_categories{'type_func_name_keyword'} = 'TYPE_FUNC_NAME_KEYWORD';
|
2012-07-05 03:47:49 +02:00
|
|
|
$keyword_categories{'reserved_keyword'} = 'RESERVED_KEYWORD';
|
2009-04-29 07:05:57 +02:00
|
|
|
|
2017-03-27 04:24:13 +02:00
|
|
|
open(my $gram, '<', $gram_filename) || die("Could not open : $gram_filename");
|
2009-04-30 12:26:35 +02:00
|
|
|
|
2017-03-27 04:24:13 +02:00
|
|
|
my $kcat;
|
2009-04-30 12:26:35 +02:00
|
|
|
my $comment;
|
|
|
|
my @arr;
|
|
|
|
my %keywords;
|
|
|
|
|
2017-03-27 04:24:13 +02:00
|
|
|
line: while (my $S = <$gram>)
|
2012-07-05 03:47:49 +02:00
|
|
|
{
|
2017-03-27 04:24:13 +02:00
|
|
|
chomp $S; # strip record separator
|
2009-04-29 07:05:57 +02:00
|
|
|
|
2017-03-27 04:24:13 +02:00
|
|
|
my $s;
|
2009-04-29 07:05:57 +02:00
|
|
|
|
2012-07-05 03:47:49 +02:00
|
|
|
# Make sure any braces are split
|
|
|
|
$s = '{', $S =~ s/$s/ { /g;
|
|
|
|
$s = '}', $S =~ s/$s/ } /g;
|
2009-04-29 07:05:57 +02:00
|
|
|
|
2012-07-05 03:47:49 +02:00
|
|
|
# Any comments are split
|
|
|
|
$s = '[/][*]', $S =~ s#$s# /* #g;
|
|
|
|
$s = '[*][/]', $S =~ s#$s# */ #g;
|
2009-04-29 07:05:57 +02:00
|
|
|
|
2012-07-05 03:47:49 +02:00
|
|
|
if (!($kcat))
|
|
|
|
{
|
2013-05-29 22:58:43 +02:00
|
|
|
|
2012-07-05 03:47:49 +02:00
|
|
|
# Is this the beginning of a keyword list?
|
2017-03-27 04:24:13 +02:00
|
|
|
foreach my $k (keys %keyword_categories)
|
2012-07-05 03:47:49 +02:00
|
|
|
{
|
|
|
|
if ($S =~ m/^($k):/)
|
|
|
|
{
|
|
|
|
$kcat = $k;
|
|
|
|
next line;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
next line;
|
2009-04-29 07:05:57 +02:00
|
|
|
}
|
2010-11-23 21:27:50 +01:00
|
|
|
|
2012-07-05 03:47:49 +02:00
|
|
|
# Now split the line into individual fields
|
2017-03-27 04:24:13 +02:00
|
|
|
my $n = (@arr = split(' ', $S));
|
2012-07-05 03:47:49 +02:00
|
|
|
|
|
|
|
# Ok, we're in a keyword list. Go through each field in turn
|
|
|
|
for (my $fieldIndexer = 0; $fieldIndexer < $n; $fieldIndexer++)
|
|
|
|
{
|
|
|
|
if ($arr[$fieldIndexer] eq '*/' && $comment)
|
|
|
|
{
|
|
|
|
$comment = 0;
|
|
|
|
next;
|
|
|
|
}
|
|
|
|
elsif ($comment)
|
|
|
|
{
|
|
|
|
next;
|
|
|
|
}
|
|
|
|
elsif ($arr[$fieldIndexer] eq '/*')
|
|
|
|
{
|
2013-05-29 22:58:43 +02:00
|
|
|
|
2012-07-05 03:47:49 +02:00
|
|
|
# start of a multiline comment
|
|
|
|
$comment = 1;
|
|
|
|
next;
|
|
|
|
}
|
|
|
|
elsif ($arr[$fieldIndexer] eq '//')
|
|
|
|
{
|
|
|
|
next line;
|
|
|
|
}
|
|
|
|
|
|
|
|
if ($arr[$fieldIndexer] eq ';')
|
|
|
|
{
|
2013-05-29 22:58:43 +02:00
|
|
|
|
2012-07-05 03:47:49 +02:00
|
|
|
# end of keyword list
|
|
|
|
$kcat = '';
|
|
|
|
next;
|
|
|
|
}
|
|
|
|
|
|
|
|
if ($arr[$fieldIndexer] eq '|')
|
|
|
|
{
|
|
|
|
next;
|
|
|
|
}
|
|
|
|
|
|
|
|
# Put this keyword into the right list
|
|
|
|
push @{ $keywords{$kcat} }, $arr[$fieldIndexer];
|
|
|
|
}
|
2009-04-29 07:05:57 +02:00
|
|
|
}
|
2017-03-27 04:24:13 +02:00
|
|
|
close $gram;
|
2009-04-29 07:05:57 +02:00
|
|
|
|
2012-09-27 05:10:52 +02:00
|
|
|
# Check that each keyword list is in alphabetical order (just for neatnik-ism)
|
2017-03-27 04:24:13 +02:00
|
|
|
my ($prevkword, $bare_kword);
|
|
|
|
foreach my $kcat (keys %keyword_categories)
|
2012-07-05 03:47:49 +02:00
|
|
|
{
|
|
|
|
$prevkword = '';
|
|
|
|
|
2017-03-27 04:24:13 +02:00
|
|
|
foreach my $kword (@{ $keywords{$kcat} })
|
2012-07-05 03:47:49 +02:00
|
|
|
{
|
2013-05-29 22:58:43 +02:00
|
|
|
|
2012-07-05 03:47:49 +02:00
|
|
|
# Some keyword have a _P suffix. Remove it for the comparison.
|
|
|
|
$bare_kword = $kword;
|
|
|
|
$bare_kword =~ s/_P$//;
|
|
|
|
if ($bare_kword le $prevkword)
|
|
|
|
{
|
|
|
|
error
|
|
|
|
"'$bare_kword' after '$prevkword' in $kcat list is misplaced";
|
|
|
|
}
|
|
|
|
$prevkword = $bare_kword;
|
2009-04-29 07:05:57 +02:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
# Transform the keyword lists into hashes.
|
2012-09-27 05:10:52 +02:00
|
|
|
# kwhashes is a hash of hashes, keyed by keyword category id,
|
|
|
|
# e.g. UNRESERVED_KEYWORD.
|
|
|
|
# Each inner hash is keyed by keyword id, e.g. ABORT_P, with a dummy value.
|
2009-04-30 12:26:35 +02:00
|
|
|
my %kwhashes;
|
2012-07-05 03:47:49 +02:00
|
|
|
while (my ($kcat, $kcat_id) = each(%keyword_categories))
|
|
|
|
{
|
|
|
|
@arr = @{ $keywords{$kcat} };
|
2009-04-29 07:05:57 +02:00
|
|
|
|
2012-07-05 03:47:49 +02:00
|
|
|
my $hash;
|
2012-09-27 05:10:52 +02:00
|
|
|
foreach my $item (@arr) { $hash->{$item} = 1; }
|
2009-04-29 07:05:57 +02:00
|
|
|
|
2012-07-05 03:47:49 +02:00
|
|
|
$kwhashes{$kcat_id} = $hash;
|
2009-04-29 07:05:57 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
# Now read in kwlist.h
|
|
|
|
|
2017-03-27 04:24:13 +02:00
|
|
|
open(my $kwlist, '<', $kwlist_filename) || die("Could not open : $kwlist_filename");
|
2009-04-29 07:05:57 +02:00
|
|
|
|
2009-04-30 12:26:35 +02:00
|
|
|
my $prevkwstring = '';
|
|
|
|
my $bare_kwname;
|
|
|
|
my %kwhash;
|
2017-03-27 04:24:13 +02:00
|
|
|
kwlist_line: while (<$kwlist>)
|
2012-07-05 03:47:49 +02:00
|
|
|
{
|
|
|
|
my ($line) = $_;
|
|
|
|
|
|
|
|
if ($line =~ /^PG_KEYWORD\(\"(.*)\", (.*), (.*)\)/)
|
|
|
|
{
|
|
|
|
my ($kwstring) = $1;
|
|
|
|
my ($kwname) = $2;
|
|
|
|
my ($kwcat_id) = $3;
|
|
|
|
|
2012-09-27 05:10:52 +02:00
|
|
|
# Check that the list is in alphabetical order (critical!)
|
2012-07-05 03:47:49 +02:00
|
|
|
if ($kwstring le $prevkwstring)
|
|
|
|
{
|
|
|
|
error
|
|
|
|
"'$kwstring' after '$prevkwstring' in kwlist.h is misplaced";
|
|
|
|
}
|
|
|
|
$prevkwstring = $kwstring;
|
|
|
|
|
|
|
|
# Check that the keyword string is valid: all lower-case ASCII chars
|
2012-09-27 05:10:52 +02:00
|
|
|
if ($kwstring !~ /^[a-z_]+$/)
|
2012-07-05 03:47:49 +02:00
|
|
|
{
|
|
|
|
error
|
|
|
|
"'$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
|
2012-09-27 05:10:52 +02:00
|
|
|
if ($kwname !~ /^[A-Z_]+$/)
|
2012-07-05 03:47:49 +02:00
|
|
|
{
|
|
|
|
error
|
|
|
|
"'$kwname' is not a valid keyword name, must be all upper-case ASCII chars";
|
|
|
|
}
|
|
|
|
|
|
|
|
# Check that the keyword string matches keyword name
|
|
|
|
$bare_kwname = $kwname;
|
|
|
|
$bare_kwname =~ s/_P$//;
|
|
|
|
if ($bare_kwname ne uc($kwstring))
|
|
|
|
{
|
|
|
|
error
|
|
|
|
"keyword name '$kwname' doesn't match keyword string '$kwstring'";
|
|
|
|
}
|
|
|
|
|
|
|
|
# Check that the keyword is present in the grammar
|
|
|
|
%kwhash = %{ $kwhashes{$kwcat_id} };
|
|
|
|
|
|
|
|
if (!(%kwhash))
|
|
|
|
{
|
2012-09-27 05:10:52 +02:00
|
|
|
error "Unknown keyword category: $kwcat_id";
|
2012-07-05 03:47:49 +02:00
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
|
|
|
if (!($kwhash{$kwname}))
|
|
|
|
{
|
|
|
|
error "'$kwname' not present in $kwcat_id section of gram.y";
|
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
2013-05-29 22:58:43 +02:00
|
|
|
|
2012-09-27 05:10:52 +02:00
|
|
|
# Remove it from the hash, so that we can
|
|
|
|
# complain at the end if there's keywords left
|
|
|
|
# that were not found in kwlist.h
|
2012-07-05 03:47:49 +02:00
|
|
|
delete $kwhashes{$kwcat_id}->{$kwname};
|
|
|
|
}
|
|
|
|
}
|
2009-04-29 07:05:57 +02:00
|
|
|
}
|
|
|
|
}
|
2017-03-27 04:24:13 +02:00
|
|
|
close $kwlist;
|
2009-04-29 07:05:57 +02:00
|
|
|
|
|
|
|
# Check that we've paired up all keywords from gram.y with lines in kwlist.h
|
2012-07-05 03:47:49 +02:00
|
|
|
while (my ($kwcat, $kwcat_id) = each(%keyword_categories))
|
|
|
|
{
|
|
|
|
%kwhash = %{ $kwhashes{$kwcat_id} };
|
2009-04-29 07:05:57 +02:00
|
|
|
|
2012-07-05 03:47:49 +02:00
|
|
|
for my $kw (keys %kwhash)
|
|
|
|
{
|
|
|
|
error "'$kw' found in gram.y $kwcat category, but not in kwlist.h";
|
|
|
|
}
|
2009-04-29 07:05:57 +02:00
|
|
|
}
|
2012-02-27 12:53:12 +01:00
|
|
|
|
|
|
|
exit $errors;
|