1
# Copyright (C) 2008-2009 Sun Microsystems, Inc. All rights reserved.
2
# Use is subject to license terms.
4
# This program is free software; you can redistribute it and/or modify
5
# it under the terms of the GNU General Public License as published by
6
# the Free Software Foundation; version 2 of the License.
8
# This program is distributed in the hope that it will be useful, but
9
# WITHOUT ANY WARRANTY; without even the implied warranty of
10
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11
# General Public License for more details.
13
# You should have received a copy of the GNU General Public License
14
# along with this program; if not, write to the Free Software
15
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301
18
package GenTest::Generator::FromGrammar;
21
@ISA = qw(GenTest::Generator GenTest);
24
use GenTest::Constants;
26
use GenTest::Generator;
28
use GenTest::Grammar::Rule;
29
use GenTest::Stack::Stack;
33
use constant GENERATOR_MAX_OCCURRENCES => 3500;
34
use constant GENERATOR_MAX_LENGTH => 10000;
41
my $generator = $class->SUPER::new(@_);
43
if (not defined $generator->grammar()) {
44
# say("Loading grammar file '".$generator->grammarFile()."' ...");
45
$generator->[GENERATOR_GRAMMAR] = GenTest::Grammar->new(
46
grammar_file => $generator->grammarFile(),
47
grammar_string => $generator->grammarString()
49
return undef if not defined $generator->[GENERATOR_GRAMMAR];
52
if (not defined $generator->prng()) {
53
$generator->[GENERATOR_PRNG] = GenTest::Random->new(
54
seed => $generator->[GENERATOR_SEED] || 0,
55
varchar_length => $generator->[GENERATOR_VARCHAR_LENGTH]
59
if (not defined $generator->maskLevel()) {
60
$generator->[GENERATOR_MASK_LEVEL] = 1;
63
$generator->[GENERATOR_SEQ_ID] = 0;
65
if ($generator->mask() > 0) {
66
my $grammar = $generator->grammar();
67
my $top = $grammar->topGrammar($generator->maskLevel(),
68
"thread".$generator->threadId(),
70
my $maskedTop = $top->mask($generator->mask());
71
$generator->[GENERATOR_MASKED_GRAMMAR] = $grammar->patch($maskedTop);
79
$self->[GENERATOR_GLOBAL_FRAME] = GenTest::Stack::StackFrame->new()
80
if not defined $self->[GENERATOR_GLOBAL_FRAME];
81
return $self->[GENERATOR_GLOBAL_FRAME];
84
sub participatingRules {
85
return $_[0]->[GENERATOR_PARTICIPATING_RULES];
89
# Generate a new query. We do this by iterating over the array containing grammar rules and expanding each grammar rule
90
# to one of its right-side components . We do that in-place in the array.
92
# Finally, we walk the array and replace all lowercase keywors with literals and such.
96
my ($generator, $executors) = @_;
98
my $grammar = $generator->grammar();
99
my $prng = $generator->prng();
100
my $mask = $generator->mask();
101
my $mask_level = $generator->maskLevel();
103
my $stack = GenTest::Stack::Stack->new();
104
my $global = $generator->globalFrame();
107
# If a temporary file has been left from a previous statement, unlink it.
110
unlink($generator->[GENERATOR_TMPNAM]) if defined $generator->[GENERATOR_TMPNAM];
111
$generator->[GENERATOR_TMPNAM] = undef;
115
# If this is our first query, we look for a rule named "threadN_init" or "query_init"
116
if ($generator->seqId() == 0) {
118
$grammar->firstMatchingRule("thread".$generator->threadId()."_init",
120
$mask = 0 if defined $starting_rule;
121
# Do not apply mask on _init rules.
125
if (defined $generator->maskedGrammar()) {
126
$grammar = $generator->maskedGrammar();
129
# If no init starting rule, we look for rules named "threadN" or "query"
131
$grammar->firstMatchingRule("thread".$generator->threadId(),
133
if not defined $starting_rule;
135
my @sentence = ($starting_rule);
137
my $grammar_rules = $grammar->rules();
139
# And we do multiple iterations, continuously expanding grammar rules and replacing the original rule with its expansion.
148
while ($pos <= $#sentence) {
149
if ($#sentence > GENERATOR_MAX_LENGTH) {
150
say("Sentence is now longer than ".GENERATOR_MAX_LENGTH()." symbols. Possible endless loop in grammar. Aborting.");
153
if (ref($sentence[$pos]) eq 'GenTest::Grammar::Rule') {
154
splice (@sentence, $pos, 1 , map {
156
$rule_counters{$_}++ if $_ ne uc($_);
158
if ($rule_counters{$_} > GENERATOR_MAX_OCCURRENCES) {
159
say("Rule $_ occured more than ".GENERATOR_MAX_OCCURRENCES()." times. Possible endless loop in grammar. Aborting.");
163
# Check if we just picked a grammar rule. If yes, then return its Rule object.
164
# If not, use the original literal, stored in $_
166
if (exists $grammar_rules->{$_}) {
167
$grammar_rules->{$_};
171
} @{$prng->arrayElement($sentence[$pos]->[GenTest::Grammar::Rule::RULE_COMPONENTS])});
173
say("Internal grammar problem: $@");
181
# Once the SQL sentence has been constructed, iterate over it to replace variable items with their final values
185
foreach (@sentence) {
193
$_ = eval("no strict;\n".$_); # Code
195
if ($@ =~ m{at \(.*?\) line}o) {
196
say("Internal grammar error: $@");
197
return undef; # Code called die()
199
warn("Syntax error in Perl snippet $orig_item : $@");
203
} elsif ($_ =~ m{^\$}so) {
204
$_ = eval("no strict;\n".$_.";\n"); # Variable
210
my $invariant_substitution=0;
211
if ($_ =~ m{^(_[a-z_]*?)\[(.*?)\]}sio) {
213
if ($modifier eq 'invariant') {
214
$invariant_substitution=1;
215
$_ = exists $invariants{$orig_item} ? $invariants{$orig_item} : $1 ;
221
next if $_ eq uc($_); # Short-cut for UPPERCASE literals
223
if ( ($_ eq 'letter') || ($_ eq '_letter') ) {
224
$_ = $prng->letter();
225
} elsif ($_ eq '_hex') {
227
} elsif ( ($_ eq 'digit') || ($_ eq '_digit') ) {
229
} elsif ($_ eq '_cwd') {
236
# Create a new temporary file name and record it for unlinking at the next statement
237
$generator->[GENERATOR_TMPNAM] = tmpdir()."gentest".$$.".tmp" if not defined $generator->[GENERATOR_TMPNAM];
238
$_ = "'".$generator->[GENERATOR_TMPNAM]."'";
239
$_ =~ s{\\}{\\\\}sgio if osWindows(); # Backslash-escape backslashes on Windows
240
} elsif ($_ eq '_tmptable') {
242
} elsif ($_ eq '_unix_timestamp') {
244
} elsif ($_ eq '_pid') {
246
} elsif ($_ eq '_thread_id') {
247
$_ = $generator->threadId();
248
} elsif ($_ eq '_thread_count') {
249
$_ = $ENV{RQG_THREADS};
250
} elsif (($_ eq '_database') || ($_ eq '_db') || ($_ eq '_schema')) {
251
my $databases = $executors->[0]->metaSchemas();
252
$last_database = $prng->arrayElement($databases);
253
$_ = '`'.$last_database.'`';
254
} elsif ($_ eq '_table') {
255
my $tables = $executors->[0]->metaTables($last_database);
256
$last_table = $prng->arrayElement($tables);
257
$_ = '`'.$last_table.'`';
258
} elsif ($_ eq '_field') {
259
my $fields = $executors->[0]->metaColumns($last_table, $last_database);
260
$_ = '`'.$prng->arrayElement($fields).'`';
261
} elsif ($_ eq '_field_list') {
262
my $fields = $executors->[0]->metaColumns($last_table, $last_database);
263
$_ = '`'.join('`,`', @$fields).'`';
264
} elsif ($_ eq '_field_count') {
265
my $fields = $executors->[0]->metaColumns($last_table, $last_database);
267
} elsif ($_ eq '_field_next') {
268
# Pick the next field that has not been picked recently and increment the $field_pos counter
269
my $fields = $executors->[0]->metaColumns($last_table, $last_database);
270
$_ = '`'.$fields->[$field_pos++ % $#$fields].'`';
271
} elsif ($_ eq '_field_no_pk') {
272
my $fields = $executors->[0]->metaColumnsTypeNot('primary',$last_table, $last_database);
273
$_ = '`'.$prng->arrayElement($fields).'`';
274
} elsif (($_ eq '_field_indexed') || ($_ eq '_field_key')) {
275
my $fields_indexed = $executors->[0]->metaColumnsType('indexed',$last_table, $last_database);
276
$_ = '`'.$prng->arrayElement($fields_indexed).'`';
277
} elsif (($_ eq '_field_unindexed') || ($_ eq '_field_nokey')) {
278
my $fields_unindexed = $executors->[0]->metaColumnsTypeNot('indexed',$last_table, $last_database);
279
$_ = '`'.$prng->arrayElement($fields_unindexed).'`';
280
} elsif ($_ eq '_collation') {
281
my $collations = $executors->[0]->metaCollations();
282
$_ = '_'.$prng->arrayElement($collations);
283
} elsif ($_ eq '_charset') {
284
my $charsets = $executors->[0]->metaCharactersets();
285
$_ = '_'.$prng->arrayElement($charsets);
286
} elsif ($_ eq '_data') {
287
$_ = $prng->file($cwd."/data");
289
($prng->isFieldType($_) == FIELD_TYPE_NUMERIC) ||
290
($prng->isFieldType($_) == FIELD_TYPE_BLOB)
292
$_ = $prng->fieldType($_);
293
} elsif ($prng->isFieldType($_)) {
294
$_ = $prng->fieldType($_);
295
if (($orig_item =~ m{`$}so) || ($_ =~ m{^(b'|0x)}so)) {
296
# Do not quote, quotes are already present
297
} elsif ($_ =~ m{'}so) {
302
} elsif ($_ =~ m{^_(.*)}sio) {
304
if ($prng->isFieldType($item_nodash)) {
305
$_ = "'".$prng->fieldType($item_nodash)."'";
314
# If the grammar initially contained a ` , restore it. This allows
315
# The generation of constructs such as `table _digit` => `table 5`
318
($orig_item =~ m{`$}so) &&
324
$invariants{$orig_item} = $_ if $modifier eq 'invariant';
327
$generator->[GENERATOR_SEQ_ID]++;
329
my $sentence = join ('', @sentence);
331
$generator->[GENERATOR_PARTICIPATING_RULES] = [ keys %rule_counters ];
333
# If this is a BEGIN ... END block then send it to server without splitting.
334
# Otherwise, split it into individual statements so that the error and the result set from each statement
338
($sentence =~ m{CREATE}sio) &&
339
($sentence =~ m{BEGIN|END}sio)
341
return [ $sentence ];
342
} elsif ($sentence =~ m{;}) {
343
my @sentences = split (';', $sentence);
346
return [ $sentence ];