← Back to branch summary

~ubuntu-branches/ubuntu/trusty/drizzle/trusty

« back to all changes in this revision

Viewing changes to tests/randgen/lib/GenTest/Generator/FromGrammar.pm

  • Committer: Package Import Robot
  • Author(s): Clint Byrum
  • Date: 2012-06-19 10:46:49 UTC
  • mfrom: (1.1.6)
  • mto: This revision was merged to the branch mainline in revision 29.
  • Revision ID: package-import@ubuntu.com-20120619104649-e2l0ggd4oz3um0f4
Tags: upstream-7.1.36-stable
Import upstream version 7.1.36-stable

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/randgen/lib/GenTest/Generator/FromGrammar.pm
 
1
# Copyright (C) 2008-2009 Sun Microsystems, Inc. All rights reserved.
 
2
# Use is subject to license terms.
 
3
#
 
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.
 
7
#
 
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.
 
12
#
 
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
 
16
# USA
 
17
 
 
18
package GenTest::Generator::FromGrammar;
 
19
 
 
20
require Exporter;
 
21
@ISA = qw(GenTest::Generator GenTest);
 
22
 
 
23
use strict;
 
24
use GenTest::Constants;
 
25
use GenTest::Random;
 
26
use GenTest::Generator;
 
27
use GenTest::Grammar;
 
28
use GenTest::Grammar::Rule;
 
29
use GenTest::Stack::Stack;
 
30
use GenTest;
 
31
use Cwd;
 
32
 
 
33
use constant GENERATOR_MAX_OCCURRENCES  => 3500;
 
34
use constant GENERATOR_MAX_LENGTH       => 10000;
 
35
 
 
36
my $field_pos;
 
37
my $cwd = cwd();
 
38
 
 
39
sub new {
 
40
        my $class = shift;
 
41
        my $generator = $class->SUPER::new(@_);
 
42
 
 
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()
 
48
                );
 
49
                return undef if not defined $generator->[GENERATOR_GRAMMAR];
 
50
        }
 
51
 
 
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]
 
56
                );
 
57
        }
 
58
        
 
59
    if (not defined $generator->maskLevel()) {
 
60
        $generator->[GENERATOR_MASK_LEVEL] = 1;    
 
61
    }
 
62
 
 
63
        $generator->[GENERATOR_SEQ_ID] = 0;
 
64
 
 
65
    if ($generator->mask() > 0) {
 
66
        my $grammar = $generator->grammar();
 
67
        my $top = $grammar->topGrammar($generator->maskLevel(),
 
68
                                       "thread".$generator->threadId(),
 
69
                                       "query");
 
70
        my $maskedTop = $top->mask($generator->mask());
 
71
        $generator->[GENERATOR_MASKED_GRAMMAR] = $grammar->patch($maskedTop);
 
72
    }
 
73
 
 
74
        return $generator;
 
75
}
 
76
 
 
77
sub globalFrame {
 
78
    my ($self) = @_;
 
79
    $self->[GENERATOR_GLOBAL_FRAME] = GenTest::Stack::StackFrame->new()
 
80
        if not defined $self->[GENERATOR_GLOBAL_FRAME];
 
81
    return $self->[GENERATOR_GLOBAL_FRAME];
 
82
}
 
83
 
 
84
sub participatingRules {
 
85
        return $_[0]->[GENERATOR_PARTICIPATING_RULES];
 
86
}
 
87
 
 
88
#
 
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.
 
91
#
 
92
# Finally, we walk the array and replace all lowercase keywors with literals and such.
 
93
#
 
94
 
 
95
sub next {
 
96
        my ($generator, $executors) = @_;
 
97
    
 
98
        my $grammar = $generator->grammar();
 
99
        my $prng = $generator->prng();
 
100
        my $mask = $generator->mask();
 
101
        my $mask_level = $generator->maskLevel();
 
102
 
 
103
    my $stack = GenTest::Stack::Stack->new();
 
104
    my $global = $generator->globalFrame();
 
105
    
 
106
        #
 
107
        # If a temporary file has been left from a previous statement, unlink it.
 
108
        #
 
109
 
 
110
        unlink($generator->[GENERATOR_TMPNAM]) if defined $generator->[GENERATOR_TMPNAM];
 
111
        $generator->[GENERATOR_TMPNAM] = undef;
 
112
 
 
113
        my $starting_rule;
 
114
 
 
115
        # If this is our first query, we look for a rule named "threadN_init" or "query_init"
 
116
        if ($generator->seqId() == 0) {
 
117
                $starting_rule = 
 
118
            $grammar->firstMatchingRule("thread".$generator->threadId()."_init",
 
119
                                        "query_init");
 
120
                $mask = 0 if defined $starting_rule;
 
121
        # Do not apply mask on _init rules.
 
122
        }
 
123
 
 
124
    ## Apply mask if any
 
125
        if (defined $generator->maskedGrammar()) {
 
126
        $grammar = $generator->maskedGrammar();
 
127
        }
 
128
 
 
129
        # If no init starting rule, we look for rules named "threadN" or "query"
 
130
        $starting_rule = 
 
131
        $grammar->firstMatchingRule("thread".$generator->threadId(),
 
132
                                    "query") 
 
133
        if not defined $starting_rule;
 
134
    
 
135
        my @sentence = ($starting_rule);
 
136
 
 
137
        my $grammar_rules = $grammar->rules();
 
138
 
 
139
        # And we do multiple iterations, continuously expanding grammar rules and replacing the original rule with its expansion.
 
140
        
 
141
        my %rule_counters;
 
142
        my %invariants;
 
143
 
 
144
        my $last_table;
 
145
        my $last_database;
 
146
 
 
147
        my $pos = 0;
 
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.");
 
151
                        return undef;
 
152
                }
 
153
                if (ref($sentence[$pos]) eq 'GenTest::Grammar::Rule') {
 
154
                        splice (@sentence, $pos, 1 , map {
 
155
 
 
156
                                $rule_counters{$_}++ if $_ ne uc($_);
 
157
 
 
158
                                if ($rule_counters{$_} > GENERATOR_MAX_OCCURRENCES) {
 
159
                                        say("Rule $_ occured more than ".GENERATOR_MAX_OCCURRENCES()." times. Possible endless loop in grammar. Aborting.");
 
160
                                        return undef;
 
161
                                }
 
162
 
 
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 $_
 
165
 
 
166
                                if (exists $grammar_rules->{$_}) {
 
167
                                        $grammar_rules->{$_};
 
168
                                } else {
 
169
                                        $_;
 
170
                                }
 
171
                        } @{$prng->arrayElement($sentence[$pos]->[GenTest::Grammar::Rule::RULE_COMPONENTS])});
 
172
                        if ($@ ne '') {
 
173
                                say("Internal grammar problem: $@");
 
174
                                return undef;
 
175
                        }
 
176
                } else {
 
177
                        $pos++;
 
178
                }
 
179
        }
 
180
 
 
181
        # Once the SQL sentence has been constructed, iterate over it to replace variable items with their final values
 
182
        
 
183
        my $item_nodash;
 
184
        my $orig_item;
 
185
        foreach (@sentence) {
 
186
                $orig_item = $_;
 
187
                next if $_ eq ' ';
 
188
 
 
189
                if (
 
190
                        ($_ =~ m{^\{}so) &&
 
191
                        ($_ =~ m{\}$}so)
 
192
                ) {
 
193
                        $_ = eval("no strict;\n".$_);           # Code
 
194
 
 
195
                        if ($@ =~ m{at \(.*?\) line}o) {
 
196
                                say("Internal grammar error: $@");
 
197
                                return undef;                   # Code called die()
 
198
                        } elsif ($@ ne '') {
 
199
                                warn("Syntax error in Perl snippet $orig_item : $@");
 
200
                                return undef;
 
201
                        }
 
202
                        next;
 
203
                } elsif ($_ =~ m{^\$}so) {
 
204
                        $_ = eval("no strict;\n".$_.";\n");     # Variable
 
205
                        next;
 
206
                }
 
207
 
 
208
                my $modifier;
 
209
 
 
210
                my $invariant_substitution=0;
 
211
                if ($_ =~ m{^(_[a-z_]*?)\[(.*?)\]}sio) {
 
212
                        $modifier = $2;
 
213
                        if ($modifier eq 'invariant') {
 
214
                                $invariant_substitution=1;
 
215
                                $_ = exists $invariants{$orig_item} ? $invariants{$orig_item} : $1 ;
 
216
                        } else {
 
217
                                $_ = $1;
 
218
                        }
 
219
                }
 
220
 
 
221
                next if $_ eq uc($_);                           # Short-cut for UPPERCASE literals
 
222
 
 
223
                if ( ($_ eq 'letter') || ($_ eq '_letter') ) {
 
224
                        $_ = $prng->letter();
 
225
                } elsif ($_ eq '_hex') {
 
226
                        $_ = $prng->hex();
 
227
                } elsif ( ($_ eq 'digit')  || ($_ eq '_digit') ) {
 
228
                        $_ = $prng->digit();
 
229
                } elsif ($_ eq '_cwd') {
 
230
                        $_ = "'".$cwd."'";
 
231
                } elsif (
 
232
                        ($_ eq '_tmpnam') ||
 
233
                        ($_ eq 'tmpnam') ||
 
234
                        ($_ eq '_tmpfile')
 
235
                ) {
 
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') {
 
241
                        $_ = "tmptable".$$;
 
242
                } elsif ($_ eq '_unix_timestamp') {
 
243
                        $_ = time();
 
244
                } elsif ($_ eq '_pid') {
 
245
                        $_ = $$;
 
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);
 
266
                        $_ = $#$fields + 1;
 
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");
 
288
                } elsif (
 
289
                        ($prng->isFieldType($_) == FIELD_TYPE_NUMERIC) ||
 
290
                        ($prng->isFieldType($_) == FIELD_TYPE_BLOB) 
 
291
                ) {
 
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) {
 
298
                                $_ = '"'.$_.'"';
 
299
                        } else {
 
300
                                $_ = "'".$_."'";
 
301
                        }
 
302
                } elsif ($_ =~ m{^_(.*)}sio) {
 
303
                        $item_nodash = $1;
 
304
                        if ($prng->isFieldType($item_nodash)) {
 
305
                                $_ = "'".$prng->fieldType($item_nodash)."'";
 
306
                                if ($_ =~ m{'}so) {
 
307
                                        $_ = '"'.$_.'"';
 
308
                                } else {
 
309
                                        $_ = "'".$_."'";
 
310
                                }
 
311
                        }
 
312
                }
 
313
 
 
314
                # If the grammar initially contained a ` , restore it. This allows
 
315
                # The generation of constructs such as `table _digit` => `table 5`
 
316
 
 
317
                if (
 
318
                        ($orig_item =~ m{`$}so) && 
 
319
                        ($_ !~ m{`}so)
 
320
                ) {
 
321
                        $_ = $_.'`';
 
322
                }
 
323
        
 
324
                $invariants{$orig_item} = $_ if $modifier eq 'invariant';
 
325
        }
 
326
 
 
327
        $generator->[GENERATOR_SEQ_ID]++;
 
328
 
 
329
        my $sentence = join ('', @sentence);
 
330
 
 
331
        $generator->[GENERATOR_PARTICIPATING_RULES] = [ keys %rule_counters ];
 
332
 
 
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
 
335
        # can be examined
 
336
 
 
337
        if (
 
338
                ($sentence =~ m{CREATE}sio) && 
 
339
                ($sentence =~ m{BEGIN|END}sio)
 
340
        ) {
 
341
                return [ $sentence ];
 
342
        } elsif ($sentence =~ m{;}) {
 
343
                my @sentences = split (';', $sentence);
 
344
                return \@sentences;
 
345
        } else {
 
346
                return [ $sentence ];
 
347
        }
 
348
}
 
349
 
 
350
1;