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->[GENERATOR_GRAMMAR];
99
my $grammar_rules = $grammar->rules();
101
my $prng = $generator->[GENERATOR_PRNG];
103
my $stack = GenTest::Stack::Stack->new();
104
my $global = $generator->globalFrame();
113
# If a temporary file has been left from a previous statement, unlink it.
116
unlink($generator->[GENERATOR_TMPNAM]) if defined $generator->[GENERATOR_TMPNAM];
117
$generator->[GENERATOR_TMPNAM] = undef;
121
# If this is our first query, we look for a rule named "threadN_init" or "query_init"
122
if ($generator->[GENERATOR_SEQ_ID] == 0) {
123
if (exists $grammar_rules->{"thread".$generator->threadId()."_init"}) {
124
$starting_rule = "thread".$generator->threadId()."_init";
125
} elsif (exists $grammar_rules->{"query_init"}) {
126
$starting_rule = "query_init";
131
$grammar = $generator->[GENERATOR_MASKED_GRAMMAR] if defined $generator->[GENERATOR_MASKED_GRAMMAR];
132
$grammar_rules = $grammar->rules();
134
# If no init starting rule, we look for rules named "threadN" or "query"
136
if (not defined $starting_rule) {
137
if (exists $grammar_rules->{"thread".$generator->threadId()}) {
138
$starting_rule = $grammar_rules->{"thread".$generator->threadId()}->name();
140
$starting_rule = "query";
144
my @sentence = ($starting_rule);
145
for (my $pos = 0; $pos <= $#sentence; $pos++) {
146
$_ = $sentence[$pos];
148
next if $_ eq uc($_);
149
next if not exists $grammar_rules->{$_};
151
if (++$rule_counters{$_} > GENERATOR_MAX_OCCURRENCES) {
152
say("Rule $_ occured more than ".GENERATOR_MAX_OCCURRENCES()." times. Possible endless loop in grammar. Aborting.");
156
# Expand grammar rule into one of its productions
158
splice(@sentence, $pos, 1, @{$grammar_rules->{$_}->[GenTest::Grammar::Rule::RULE_COMPONENTS]->[
159
$prng->uint16(0, $#{$grammar_rules->{$_}->[GenTest::Grammar::Rule::RULE_COMPONENTS]})
162
if ($#sentence > GENERATOR_MAX_LENGTH) {
163
say("Sentence is now longer than ".GENERATOR_MAX_LENGTH()." symbols. Possible endless loop in grammar. Aborting.");
167
# Process the current element of @sentence once more, as it was just expanded
171
# Once the SQL sentence has been constructed, iterate over it to replace variable items with their final values
176
foreach (@sentence) {
178
next if $_ eq uc($_); # Short-cut for UPPERCASE literals
179
next if $_ eq 'executor1' || $_ eq 'executor2' || $_ eq 'executor3' ;
184
(substr($_, 0, 1) eq '{') &&
185
(substr($_, -1, 1) eq '}')
187
$_ = eval("no strict;\n".$_); # Code
190
if ($@ =~ m{at .*? line}o) {
191
say("Internal grammar error: $@");
192
return undef; # Code called die()
194
warn("Syntax error in Perl snippet $orig_item : $@");
199
} elsif (substr($_, 0, 1) eq '$') {
200
$_ = eval("no strict;\n".$_.";\n"); # Variable
204
# Check for expressions such as _tinyint[invariant]
207
if (index($_, '[') > -1) {
208
my $invariant_substitution = 0;
209
if ($_ =~ m{^(_[a-z_]*?)\[(.*?)\]}sio) {
211
if ($modifier eq 'invariant') {
212
$invariant_substitution = 1;
213
$_ = exists $invariants{$orig_item} ? $invariants{$orig_item} : $1 ;
220
my $field_type = $prng->isFieldType($_);
222
if ( ($_ eq 'letter') || ($_ eq '_letter') ) {
223
$_ = $prng->letter();
224
} elsif ( ($_ eq 'digit') || ($_ eq '_digit') ) {
226
} elsif ($_ eq '_table') {
227
my $tables = $executors->[0]->metaTables($last_database);
228
$last_table = $prng->arrayElement($tables);
229
$_ = '`'.$last_table.'`';
230
} elsif ($_ eq '_field') {
231
my $fields = $executors->[0]->metaColumns($last_table, $last_database);
232
$_ = '`'.$prng->arrayElement($fields).'`';
233
} elsif ($_ eq '_hex') {
235
} elsif ($_ eq '_cwd') {
242
# Create a new temporary file name and record it for unlinking at the next statement
243
$generator->[GENERATOR_TMPNAM] = tmpdir()."gentest".$$.".tmp" if not defined $generator->[GENERATOR_TMPNAM];
244
$_ = "'".$generator->[GENERATOR_TMPNAM]."'";
245
$_ =~ s{\\}{\\\\}sgio if osWindows(); # Backslash-escape backslashes on Windows
246
} elsif ($_ eq '_tmptable') {
248
} elsif ($_ eq '_unix_timestamp') {
250
} elsif ($_ eq '_pid') {
252
} elsif ($_ eq '_thread_id') {
253
$_ = $generator->threadId();
254
} elsif ($_ eq '_thread_count') {
255
$_ = $ENV{RQG_THREADS};
256
} elsif (($_ eq '_database') || ($_ eq '_db') || ($_ eq '_schema')) {
257
my $databases = $executors->[0]->metaSchemas();
258
$last_database = $prng->arrayElement($databases);
259
$_ = '`'.$last_database.'`';
260
} elsif ($_ eq '_table') {
261
my $tables = $executors->[0]->metaTables($last_database);
262
$last_table = $prng->arrayElement($tables);
263
$_ = '`'.$last_table.'`';
264
} elsif ($_ eq '_field') {
265
my $fields = $executors->[0]->metaColumns($last_table, $last_database);
266
$_ = '`'.$prng->arrayElement($fields).'`';
267
} elsif ($_ eq '_field_list') {
268
my $fields = $executors->[0]->metaColumns($last_table, $last_database);
269
$_ = '`'.join('`,`', @$fields).'`';
270
} elsif ($_ eq '_field_count') {
271
my $fields = $executors->[0]->metaColumns($last_table, $last_database);
273
} elsif ($_ eq '_field_next') {
274
# Pick the next field that has not been picked recently and increment the $field_pos counter
275
my $fields = $executors->[0]->metaColumns($last_table, $last_database);
276
$_ = '`'.$fields->[$field_pos++ % $#$fields].'`';
277
} elsif ($_ eq '_field_no_pk') {
278
my $fields = $executors->[0]->metaColumnsTypeNot('primary',$last_table, $last_database);
279
$_ = '`'.$prng->arrayElement($fields).'`';
280
} elsif (($_ eq '_field_indexed') || ($_ eq '_field_key')) {
281
my $fields_indexed = $executors->[0]->metaColumnsType('indexed',$last_table, $last_database);
282
$_ = '`'.$prng->arrayElement($fields_indexed).'`';
283
} elsif (($_ eq '_field_unindexed') || ($_ eq '_field_nokey')) {
284
my $fields_unindexed = $executors->[0]->metaColumnsTypeNot('indexed',$last_table, $last_database);
285
$_ = '`'.$prng->arrayElement($fields_unindexed).'`';
286
} elsif ($_ eq '_collation') {
287
my $collations = $executors->[0]->metaCollations();
288
$_ = '_'.$prng->arrayElement($collations);
289
} elsif ($_ eq '_collation_name') {
290
my $collations = $executors->[0]->metaCollations();
291
$_ = $prng->arrayElement($collations);
292
} elsif ($_ eq '_charset') {
293
my $charsets = $executors->[0]->metaCharactersets();
294
$_ = '_'.$prng->arrayElement($charsets);
295
} elsif ($_ eq '_charset_name') {
296
my $charsets = $executors->[0]->metaCharactersets();
297
$_ = $prng->arrayElement($charsets);
298
} elsif ($_ eq '_data') {
299
$_ = $prng->file($cwd."/data");
301
($field_type == FIELD_TYPE_NUMERIC) ||
302
($field_type == FIELD_TYPE_BLOB)
304
$_ = $prng->fieldType($_);
305
} elsif ($field_type) {
306
$_ = $prng->fieldType($_);
308
(substr($orig_item, -1) eq '`') ||
309
(substr($orig_item, 0, 2) eq "b'") ||
310
(substr($orig_item, 0, 2) eq '0x')
312
# Do not quote, quotes are already present
313
} elsif (index($_, "'") > -1) {
318
} elsif (substr($_, 0, 1) eq '_') {
319
$item_nodash = substr($_, 1);
320
if ($prng->isFieldType($item_nodash)) {
321
$_ = "'".$prng->fieldType($item_nodash)."'";
322
if (index($_, "'") > -1) {
330
# If the grammar initially contained a ` , restore it. This allows
331
# The generation of constructs such as `table _digit` => `table 5`
334
(substr($orig_item, -1) eq '`') &&
335
(index($_, '`') == -1)
340
$invariants{$orig_item} = $_ if $modifier eq 'invariant';
343
$generator->[GENERATOR_SEQ_ID]++;
345
my $sentence = join ('', @sentence);
347
$generator->[GENERATOR_PARTICIPATING_RULES] = [ keys %rule_counters ];
349
# If this is a BEGIN ... END block then send it to server without splitting.
350
# Otherwise, split it into individual statements so that the error and the result set from each statement
354
(index($sentence, 'CREATE') > -1 ) &&
355
(index($sentence, 'BEGIN') > -1 || index($sentence, 'END') > -1)
357
return [ $sentence ];
358
} elsif (index($sentence, ';') > -1) {
359
my @sentences = split (';', $sentence);
362
return [ $sentence ];
added
removed
tests/kewpie/randgen/lib/GenTest/Generator/FromGrammar.pm
