File: bhs.pl

package info (click to toggle)
mysql-8.0 8.0.43-3
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 1,273,924 kB
  • sloc: cpp: 4,684,605; ansic: 412,450; pascal: 108,398; java: 83,641; perl: 30,221; cs: 27,067; sql: 26,594; sh: 24,181; python: 21,816; yacc: 17,169; php: 11,522; xml: 7,388; javascript: 7,076; makefile: 2,194; lex: 1,075; awk: 670; asm: 520; objc: 183; ruby: 97; lisp: 86
file content (252 lines) | stat: -rwxr-xr-x 6,618 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
#!/usr/bin/perl

use File::Basename;
use File::Copy qw(copy);
use File::Spec qw(catdir);
use File::Path;
use IO::File;
use strict;

# Constants
my $case_header= "###############################################################################\n" 
 . "# Note! The test case updated for running under blackhole slave configuration #\n"
 . "###############################################################################\n\n";
my $before_replace= "# *** BHS ***\n";
my $after_replace= "# *** /BHS ***\n";
my %copy_dirs= (
    "include"	=> "include",
    "extra"	=> "extra"
);

# Variables
my %test_dirs;
my @update_test_cases;
my %rules;
my $opt_trans_test_list;

print "Creating suite rpl_bhs\n";

# *** Set platform-independent pathes ***

# Set extension directory
my $ext_dir= dirname(File::Spec->rel2abs($0));
# Set bhs directory
my $bhs_dir= File::Spec->catdir($ext_dir, "bhs");
# Set mysql-test directory
my $mysql_test_dir= $ext_dir;
$mysql_test_dir =~ s/(\/|\\)suite(\/|\\)rpl(\/|\\)extension$//;
# Set path to mtr
my $mtr_script = File::Spec->catdir($mysql_test_dir, "mysql-test-run.pl");
# Set directory of rpl suite
my $suite_rpl_dir = File::Spec->catdir($mysql_test_dir, "suite", "rpl");
# Set directory of rpl_bhs suite
my $suite_rpl_bhs_dir = File::Spec->catdir($mysql_test_dir, "suite", "rpl_bhs");
# Set test cases mask with path
my $suite_rpl_bhs_cases_dir = File::Spec->catdir($suite_rpl_bhs_dir, "t");

# Check first argument
if ($ARGV[0] =~ m/\-\-trans\-test\-list=(.+)/i)
{
    $opt_trans_test_list= File::Spec->catdir($suite_rpl_bhs_dir, $1);
    shift @ARGV;    
    $mtr_script= "perl " . $mtr_script . " " . join(" ", @ARGV);
}
else
{
    die("First argument of bhs.pl must be --trans-test-list with path to test case list");
}

# *** Copy files ***

# Copy rpl suite into rpl_bhs
print "copying:\n  $suite_rpl_dir\n  --> $suite_rpl_bhs_dir\n";
dircopy($suite_rpl_dir, $suite_rpl_bhs_dir);

# Copy additional dirs outside of rpl suite
foreach my $cur_dir (keys %copy_dirs)
{
    my $from_dir= File::Spec->catdir($mysql_test_dir, $cur_dir);
    my $to_dir= File::Spec->catdir($suite_rpl_bhs_dir, $copy_dirs{$cur_dir});
    print "  $from_dir\n  --> $to_dir\n";
    dircopy($from_dir, $to_dir);
}

# Copy server config files
print "  configuration files\n";
copy(File::Spec->catdir($ext_dir, "bhs", "my.cnf"), $suite_rpl_bhs_dir);
copy(File::Spec->catdir($ext_dir, "bhs", "rpl_1slave_base.cnf"), $suite_rpl_bhs_dir);

# Add BHS disabled.def
print "updating disabled.def\n";
my $fh = new IO::File File::Spec->catdir($bhs_dir, "disabled.def"), "r";
if (defined $fh) {
    my @disabled = <$fh>;
    undef $fh;
    my $fh = new IO::File File::Spec->catdir($suite_rpl_bhs_dir, "t", "disabled.def"), O_WRONLY|O_APPEND;
    if (defined $fh) {
	print $fh join ("", @disabled);
	undef $fh;
    }
}


# *** Update test cases

# Read update_rules
my $fh = new IO::File File::Spec->catdir($bhs_dir, "update_test_cases"), "r";
if (defined $fh) {
    @update_test_cases = <$fh>;
    undef $fh;
}

foreach my $update (@update_test_cases)
{
    $update =~ s/\s//g;
    my ($tmpl, $file)= split(/\:/, $update);
    $file= File::Spec->catdir($bhs_dir, $file);
    $fh = new IO::File $file, "r";
    if (defined $fh) 
    {
	my @lines= <$fh>;
	undef $fh;
	my $found= "";
	my $replace= "";
	my $line_num= 0;
	foreach my $line (@lines)
	{
	    if ($line =~ m/^\s*\[(.+)\]\s*$/ && $found eq "")
	    {
		$found= $1;
	    }
	    elsif ($line =~ m/^\s*\[(.+)\]\s*$/ && $found ne "")
	    {
		$rules{$tmpl}{$found} = $replace;
		chomp $rules{$tmpl}{$found};
		$found= $1;
		$replace= "";
		$line_num= 0;
	    }
	    elsif ($line !~ m/^\s*$/)
	    {
		$replace .= $line;
		$line_num++;
	    }
	}
	if ($found ne "")
	{
	    $rules{$tmpl}{$found}= $replace;
	}
    }
}

for (my $i = 0; $i < scalar(@update_test_cases); $i++)
{
    if ($update_test_cases[$i] =~ m/(.+)\:.+/)
    {
	$update_test_cases[$i]= $1;
	my @cur_path= split(/\//, $update_test_cases[$i]);
	$update_test_cases[$i]= File::Spec->catdir(@cur_path);
	# Collect directories with test cases
	pop(@cur_path);	
	$test_dirs{File::Spec->catdir(@cur_path)}= 1;
    }
}

# Updating test cases
my $case_num= 0;
foreach my $test_dir (keys %test_dirs)
{
    # Read list of test cases
    my $cur_path= File::Spec->catdir($suite_rpl_bhs_dir, $test_dir);
    opendir(my $dh, $cur_path) or exit(1);
    my @cases = grep(/\.(test|inc)$/,readdir($dh));
    closedir($dh);    
    foreach my $case (sort @cases)
    {	
	my $case2= File::Spec->catdir($test_dir, $case);
	foreach my $update_case (@update_test_cases)
	{
	    my @paths= split(/\//, $update_case);
	    my $update_case2= File::Spec->catdir(@paths);
	    if (compare_names($case2, $update_case2) == 1)
	    {
		$fh = new IO::File File::Spec->catdir($cur_path, $case), "r";
		my @lines;
		if (defined $fh) 
		{
		    @lines = <$fh>;
		    undef $fh;
		}
		my $content= "";
		foreach my $line (@lines)
		{
		    foreach my $cmd (keys %{$rules{$update_case}})
		    {
			if ($line =~ m/$cmd/i)
			{
			    my $orig_line= "# Replaced command: " . $line;
			    $line =~ s/$cmd/$rules{$update_case}{$cmd}/;
			    $line =~ s/\n\n$/\n/;
			    $line = $before_replace . $orig_line . $line . $after_replace;
			    last;
			}
		    }
		    $content .= $line;			
		}
		$fh = new IO::File File::Spec->catdir($cur_path, $case), "w";
		if (defined $fh) 
		{
		    print $fh $case_header . $content;
		    undef $fh;
		}
		$case_num++;
		last;	    
	    }	    
	}	
    }
}

print "updated $case_num files\n";

print "Run $mtr_script\n";

system( $mtr_script );

sub compare_names
{
    my ($test, $rule)= @_;
    my $res= 0;
    $res= 1 if ($test eq $rule);
    if ($rule =~ m/\*/)
    {
	$rule =~ s/(\\|\/)+/\ /g;
	$rule =~ s/\*/\.\*/g;
	$test =~ s/(\\|\/)+/\ /g;
	$res= 1 if ($test =~ m/^$rule$/i)
    }
    return $res;
}

sub dircopy
{
    my ($from_dir, $to_dir)= @_;
    mkdir $to_dir if (! -e $to_dir);
    opendir my($dh), $from_dir or die "Could not open dir '$from_dir': $!";
    for my $entry (readdir $dh) 
    {
	next if $entry =~ /^(\.|\.\.)$/;
        my $source = File::Spec->catdir($from_dir, $entry);
        my $destination = File::Spec->catdir($to_dir, $entry);
        if (-d $source) 
        {
    	    mkdir $destination or die "mkdir '$destination' failed: $!" if not -e $destination;
            dircopy($source, $destination);
        } 
        else 
        {
    	    copy($source, $destination) or die "copy '$source' to '$destination' failed: $!";
        }
    }
    closedir $dh;
    return;                                                                                                  
}