1#!/usr/bin/perl
2# src/interfaces/ecpg/preproc/check_rules.pl
3# test parser generator for ecpg
4# call with backend grammar as stdin
5#
6# Copyright (c) 2009-2017, PostgreSQL Global Development Group
7#
8# Written by Michael Meskes <meskes@postgresql.org>
9#            Andy Colson <andy@squeakycode.net>
10#
11# Placed under the same license as PostgreSQL.
12#
13# Command line:  [-v] [path only to ecpg.addons] [full filename of gram.y]
14#  -v enables verbose mode... show's some stats... thought it might be interesting
15#
16# This script loads rule names from gram.y and sets $found{rule} = 1 for each.
17# Then it checks to make sure each rule in ecpg.addons was found in gram.y
18
19use strict;
20use warnings;
21no warnings 'uninitialized';
22
23my $verbose = 0;
24if ($ARGV[0] eq '-v')
25{
26	$verbose = shift;
27}
28my $path   = shift || '.';
29my $parser = shift || '../../../backend/parser/gram.y';
30
31my $filename = $path . "/ecpg.addons";
32if ($verbose)
33{
34	print "parser: $parser\n";
35	print "addons: $filename\n";
36}
37
38my %replace_line = (
39	'ExecuteStmtEXECUTEnameexecute_param_clause' =>
40	  'EXECUTE prepared_name execute_param_clause execute_rest',
41
42'ExecuteStmtCREATEOptTempTABLEcreate_as_targetASEXECUTEnameexecute_param_clause'
43	  => 'CREATE OptTemp TABLE create_as_target AS EXECUTE prepared_name execute_param_clause',
44
45	'PrepareStmtPREPAREnameprep_type_clauseASPreparableStmt' =>
46	  'PREPARE prepared_name prep_type_clause AS PreparableStmt');
47
48my $block        = '';
49my $yaccmode     = 0;
50my $in_rule      = 0;
51my $brace_indent = 0;
52my (@arr, %found);
53my $comment     = 0;
54my $non_term_id = '';
55my $cc          = 0;
56
57open my $parser_fh, '<', $parser or die $!;
58while (<$parser_fh>)
59{
60	if (/^%%/)
61	{
62		$yaccmode++;
63	}
64
65	if ($yaccmode != 1)
66	{
67		next;
68	}
69
70	chomp;    # strip record separator
71
72	next if ($_ eq '');
73
74	# Make sure any braces are split
75	s/{/ { /g;
76	s/}/ } /g;
77
78	# Any comments are split
79	s|\/\*| /* |g;
80	s|\*\/| */ |g;
81
82	# Now split the line into individual fields
83	my $n = (@arr = split(' '));
84
85	# Go through each field in turn
86	for (my $fieldIndexer = 0; $fieldIndexer < $n; $fieldIndexer++)
87	{
88		if ($arr[$fieldIndexer] eq '*/' && $comment)
89		{
90			$comment = 0;
91			next;
92		}
93		elsif ($comment)
94		{
95			next;
96		}
97		elsif ($arr[$fieldIndexer] eq '/*')
98		{
99
100			# start of a multiline comment
101			$comment = 1;
102			next;
103		}
104		elsif ($arr[$fieldIndexer] eq '//')
105		{
106			next;
107		}
108		elsif ($arr[$fieldIndexer] eq '}')
109		{
110			$brace_indent--;
111			next;
112		}
113		elsif ($arr[$fieldIndexer] eq '{')
114		{
115			$brace_indent++;
116			next;
117		}
118
119		if ($brace_indent > 0)
120		{
121			next;
122		}
123
124		if ($arr[$fieldIndexer] eq ';' || $arr[$fieldIndexer] eq '|')
125		{
126			$block = $non_term_id . $block;
127			if ($replace_line{$block})
128			{
129				$block = $non_term_id . $replace_line{$block};
130				$block =~ tr/ |//d;
131			}
132			$found{$block} = 1;
133			$cc++;
134			$block = '';
135			$in_rule = 0 if $arr[$fieldIndexer] eq ';';
136		}
137		elsif (($arr[$fieldIndexer] =~ '[A-Za-z0-9]+:')
138			|| $arr[ $fieldIndexer + 1 ] eq ':')
139		{
140			die "unterminated rule at grammar line $.\n"
141			  if $in_rule;
142			$in_rule     = 1;
143			$non_term_id = $arr[$fieldIndexer];
144			$non_term_id =~ tr/://d;
145		}
146		else
147		{
148			$block = $block . $arr[$fieldIndexer];
149		}
150	}
151}
152
153die "unterminated rule at end of grammar\n"
154  if $in_rule;
155
156close $parser_fh;
157if ($verbose)
158{
159	print "$cc rules loaded\n";
160}
161
162my $ret = 0;
163$cc = 0;
164
165open my $ecpg_fh, '<', $filename or die $!;
166while (<$ecpg_fh>)
167{
168	if (!/^ECPG:/)
169	{
170		next;
171	}
172
173	my @Fld = split(' ', $_, 3);
174	$cc++;
175	if (not exists $found{ $Fld[1] })
176	{
177		print $Fld[1], " is not used for building parser!\n";
178		$ret = 1;
179	}
180}
181close $ecpg_fh;
182
183if ($verbose)
184{
185	print "$cc rules checked\n";
186}
187
188exit $ret;
189