~ubuntu-branches/ubuntu/vivid/drizzle/vivid

« back to all changes in this revision

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

  • Committer: Package Import Robot
  • Author(s): Dmitrijs Ledkovs
  • Date: 2013-10-29 15:43:40 UTC
  • mfrom: (20.1.2 sid)
  • Revision ID: package-import@ubuntu.com-20131029154340-j36v7gxq9tm1gi5f
Tags: 1:7.2.3-2ubuntu1
* Merge from debian, remaining changes:
  - Link against boost_system because of boost_thread.
  - Add required libs to message/include.am
  - Add upstart job and adjust init script to be upstart compatible.
  - Disable -floop-parallelize-all due to gcc-4.8/4.9 compiler ICE
    http://gcc.gnu.org/bugzilla/show_bug.cgi?id=57732

Show diffs side-by-side

added added

removed removed

Lines of Context:
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;