← Back to branch summary

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

« back to all changes in this revision

Viewing changes to tests/randgen/lib/GenTest/Simplifier/Mysqltest.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/Simplifier/Mysqltest.pm
 
1
# Copyright (c) 2008,2010 Oracle and/or its affiliates. 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::Simplifier::Mysqltest;
 
19
 
 
20
require Exporter;
 
21
use GenTest;
 
22
@ISA = qw(GenTest);
 
23
 
 
24
use strict;
 
25
use lib 'lib';
 
26
use GenTest;
 
27
use GenTest::Constants;
 
28
 
 
29
my @csv_modules = (
 
30
        'Text::CSV',
 
31
        'Text::CSV_XS',
 
32
        'Text::CSV_PP'
 
33
);
 
34
 
 
35
use constant SIMPLIFIER_ORACLE          => 0;
 
36
use constant SIMPLIFIER_FILTER          => 1;
 
37
use constant SIMPLIFIER_USE_CONNECTIONS => 2;
 
38
 
 
39
1;
 
40
 
 
41
sub new {
 
42
        my $class = shift;
 
43
 
 
44
        my $simplifier = $class->SUPER::new({
 
45
                oracle          => SIMPLIFIER_ORACLE,
 
46
                filter          => SIMPLIFIER_FILTER,
 
47
                use_connections => SIMPLIFIER_USE_CONNECTIONS
 
48
        }, @_);
 
49
 
 
50
        return $simplifier;
 
51
}
 
52
 
 
53
sub simplify {
 
54
        my ($simplifier, $initial_mysqltest) = @_;
 
55
 
 
56
        my @queries_filtered;
 
57
 
 
58
        if (defined $simplifier->[SIMPLIFIER_FILTER]) {
 
59
                my $filter = $simplifier->[SIMPLIFIER_FILTER];
 
60
                foreach (split("\n", $initial_mysqltest)) {
 
61
                        push @queries_filtered, $_ if $_ !~ m{$filter}sio;
 
62
                }
 
63
        } else {
 
64
                @queries_filtered = split("\n", $initial_mysqltest);
 
65
        }
 
66
 
 
67
        say(($#queries_filtered + 1)." queries remain after filtering.");
 
68
 
 
69
        if (!$simplifier->oracle(join("\n", @queries_filtered)."\n")) {
 
70
                warn("Initial mysqltest (after filtering) failed oracle check.");
 
71
                return undef;
 
72
        }
 
73
 
 
74
        my $ddmin_outcome = $simplifier->ddmin(\@queries_filtered);
 
75
        my $final_mysqltest = join("\n", @$ddmin_outcome)."\n";
 
76
 
 
77
        if (!$simplifier->oracle($final_mysqltest)) {
 
78
                warn("Final mysqltest failed oracle check.");
 
79
                return undef;
 
80
        } else {
 
81
                return $final_mysqltest;
 
82
        }
 
83
}
 
84
 
 
85
sub simplifyFromCSV {
 
86
        my ($simplifier, $csv_file) = @_;
 
87
 
 
88
        my $csv;
 
89
        foreach my $csv_module (@csv_modules) {
 
90
                eval ("require $csv_module");
 
91
                if (!$@) {
 
92
                        $csv = $csv_module->new({ 'escape_char' => '\\' });
 
93
                        say("Loaded CSV module $csv_module");
 
94
                        last;
 
95
                }
 
96
        }
 
97
 
 
98
        die "Unable to load a CSV Perl module" if not defined $csv;
 
99
 
 
100
        my @mysqltest;
 
101
        
 
102
        open (CSV_HANDLE, "<", $csv_file) or die $!;
 
103
        my %connections;
 
104
        my $last_connection;
 
105
        while (<CSV_HANDLE>) {
 
106
                $_ =~ s{\\n}{ }sgio;
 
107
                if ($csv->parse($_)) {
 
108
                        my @columns = $csv->fields();
 
109
                        my $connection_id = $columns[2];
 
110
                        my $connection_name = 'connection_'.$connection_id;
 
111
                        my $command = $columns[4];
 
112
                        my $query = $columns[5];
 
113
 
 
114
                        if (($command eq 'Connect') && ($simplifier->[SIMPLIFIER_USE_CONNECTIONS])) {
 
115
                                my ($username, $host, $database) = $query =~ m{(.*?)\@(.*?) on (.*)}sio;
 
116
                                push @mysqltest, "--connect ($connection_name, localhost, $username, , $database)";
 
117
                                $connections{$connection_name}++;
 
118
                        } elsif (($command eq 'Quit') && ($simplifier->[SIMPLIFIER_USE_CONNECTIONS])) {
 
119
                                push @mysqltest, "--disconnect $connection_name";
 
120
         } elsif ($command eq 'Query' or $command eq 'Init DB') {
 
121
                                if (($last_connection ne $connection_name) && ($simplifier->[SIMPLIFIER_USE_CONNECTIONS])) {
 
122
                                        if (not exists $connections{$connection_name}) {
 
123
                                                push @mysqltest, "--connect ($connection_name, localhost, root, , test)";
 
124
                                                $connections{$connection_name}++;
 
125
                                        }
 
126
 
 
127
                                        push @mysqltest, "--connection $connection_name";
 
128
                                        $last_connection = $connection_name;
 
129
                                }
 
130
                        
 
131
                                $query =~ s{\\n}{ }sgio;
 
132
                                $query =~ s{\\\\}{\\}sgio;
 
133
 
 
134
            if ($command eq 'Init DB') {
 
135
               # mysqldump causes entries like
 
136
               #    ...,"root[root] @ localhost [127.0.0.1]",17,1,"Init DB","test1"
 
137
               # which seem to change the default database to the database named at the end of the line.
 
138
               # Replace this by USE <database>
 
139
               push @mysqltest, ('USE '.$query.';');
 
140
            } else {
 
141
                                   if ($query =~ m{;}){
 
142
                                           push @mysqltest, ("DELIMITER |;",$query.'|', "DELIMITER ;|");
 
143
                                   } else {
 
144
                                           push @mysqltest, $query.';';
 
145
                                   }
 
146
            }
 
147
                        }
 
148
           } else {
 
149
                        my $err = $csv->error_input;
 
150
                        say ("Failed to parse line: $err");
 
151
                }
 
152
        }
 
153
        close CSV_HANDLE;
 
154
 
 
155
        say("Loaded ".($#mysqltest + 1)." lines from CSV");
 
156
 
 
157
        return $simplifier->simplify(join("\n", @mysqltest)."\n");
 
158
}
 
159
 
 
160
sub oracle {
 
161
        my ($simplifier, $mysqltest) = @_;
 
162
 
 
163
        my $oracle = $simplifier->[SIMPLIFIER_ORACLE];
 
164
 
 
165
        return $oracle->($mysqltest); 
 
166
}
 
167
 
 
168
#
 
169
# This is an implementation of the ddmin algorithm, as described in "Why Programs Fail" by Andreas Zeller
 
170
#
 
171
 
 
172
sub ddmin {
 
173
        my ($simplifier, $inputs) = @_;
 
174
        say("input_size: ".($#$inputs + 1));
 
175
        my $splits = 2;
 
176
 
 
177
        # We start from 1, as to preserve the top-most queries since they are usually vital
 
178
        my $starting_subset = 1;
 
179
 
 
180
        outer: while (2 <= @$inputs) {
 
181
                my @subsets = subsets($inputs, $splits);
 
182
                say("inputs: ".($#$inputs + 1)."; splits: $splits; subsets: ".($#subsets + 1));
 
183
 
 
184
                my $some_complement_is_failing = 0;
 
185
                foreach my $subset_id ($starting_subset..$#subsets) {
 
186
                        my $subset = $subsets[$subset_id];
 
187
                        my $complement = listMinus($inputs, $subset);
 
188
                        say("subset_id: $subset_id; subset_size: ".($#$subset + 1)."; complement_size: ".($#$complement + 1));
 
189
#                       say("subset: ".join('|',@$subset));
 
190
#                       say("complement: ".join('|',@$complement));
 
191
                        if ($simplifier->oracle(join("\n", @$complement)) == ORACLE_ISSUE_STILL_REPEATABLE) {
 
192
                                $starting_subset = $subset_id;  # At next iteration, continue from where we left off 
 
193
                                $inputs = $complement;
 
194
                                $splits-- if $splits > 2;
 
195
                                $some_complement_is_failing = 1;
 
196
                                next outer;
 
197
                        }
 
198
                }
 
199
 
 
200
                if (!$some_complement_is_failing) {
 
201
                        last if $splits == ($#$inputs + 1);
 
202
                        $splits = $splits * 2 > $#$inputs + 1 ? $#$inputs + 1 : $splits * 2;
 
203
                }
 
204
 
 
205
                $starting_subset = 1;   # Reached EOF, start again from the top
 
206
 
 
207
        }
 
208
 
 
209
        return $inputs;
 
210
}
 
211
 
 
212
sub subsets {
 
213
        my ($list1, $subset_count) = @_;
 
214
 
 
215
        my $subset_size = int(($#$list1 + 1) / $subset_count);
 
216
 
 
217
        my @subsets;
 
218
        my $current_subset = 0;
 
219
        foreach my $element_id (0..$#$list1) {
 
220
                push @{$subsets[$current_subset]}, $list1->[$element_id];
 
221
                $current_subset++ if ($#{$subsets[$current_subset]} + 1) >= $subset_size && ($current_subset + 1) < $subset_count;
 
222
        }
 
223
 
 
224
        return @subsets;
 
225
}
 
226
 
 
227
sub listMinus {
 
228
        my ($list1, $list2) = @_;
 
229
 
 
230
        my $list1_string = join("\n", @$list1);
 
231
        my $list2_string = join("\n", @$list2);
 
232
        
 
233
        my $list3_string = $list1_string;
 
234
        my $list2_pos = index($list1_string, $list2_string);
 
235
        if ($list2_pos > -1) {
 
236
                substr($list3_string, $list2_pos, length($list2_string), '');
 
237
                $list3_string =~ s{^\n}{}sgio;
 
238
                $list3_string =~ s{\n$}{}sgio;
 
239
                my @list3 = split (m{\n+}, $list3_string);
 
240
                return \@list3;
 
241
        } else {
 
242
                die "list2 is not a subset of list1";
 
243
        }
 
244
}       
 
245
 
 
246
1;