← Back to branch summary

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

« back to all changes in this revision

Viewing changes to tests/randgen/lib/GenTest/Simplifier/Mysqltest.pm

  • Committer: Package Import Robot
  • Author(s): Tobias Frost
  • Date: 2013-08-22 20:18:31 UTC
  • mto: (20.1.1 sid)
  • mto: This revision was merged to the branch mainline in revision 21.
  • Revision ID: package-import@ubuntu.com-20130822201831-gn3ozsh7o7wmc5tk
Tags: upstream-7.2.3
Import upstream version 7.2.3

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;