Skip to content

Commit ee4a887

Browse files
Merge pull request diffblue#1458 from LAJW/perl-platform
TG-945 Add default platform arguments and benchmarking to the perl script
2 parents 5196e40 + 4da5a94 commit ee4a887

File tree

1 file changed

+24
-5
lines changed

1 file changed

+24
-5
lines changed

regression/test.pl

+24-5
Original file line numberDiff line numberDiff line change
@@ -64,9 +64,21 @@ ($)
6464
return @data;
6565
}
6666

67-
sub test($$$$$$) {
68-
my ($name, $test, $t_level, $cmd, $ign, $dry_run) = @_;
67+
sub test($$$$$$$) {
68+
my ($name, $test, $t_level, $cmd, $ign, $dry_run, $defines) = @_;
6969
my ($level, $input, $options, $grep_options, @results) = load("$test");
70+
my @keys = keys %{$defines};
71+
foreach my $key (@keys) {
72+
my $value = $defines->{$key};
73+
$options =~ s/(\$$key$|\$$key )/$value /g;
74+
}
75+
if (scalar @keys) {
76+
foreach my $word (split(/\s/, $options)) {
77+
if ((substr($word, 0, 1) cmp '$') == 0) {
78+
print "$name: variable \"$word\" not replaced; consider passing \"-D$word\"=...";
79+
}
80+
}
81+
}
7082

7183
# If the 4th line is activate-multi-line-match we enable multi-line checks
7284
if($grep_options ne "activate-multi-line-match") {
@@ -227,6 +239,8 @@ ($$$$)
227239
-T thorough: run expensive tests
228240
-F future: run checks for future features
229241
-K known: run tests associated with known bugs
242+
-D <key=value> Define - replace \$key string with "value" string in
243+
test descriptors
230244
231245
232246
test.pl expects a test.desc file in each subdirectory. The file test.desc
@@ -258,10 +272,12 @@ ($$$$)
258272
}
259273

260274
use Getopt::Std;
275+
use Getopt::Long qw(:config pass_through bundling);
261276
$main::VERSION = 0.1;
262277
$Getopt::Std::STANDARD_HELP_VERSION = 1;
263-
our ($opt_c, $opt_i, $opt_j, $opt_n, $opt_h, $opt_C, $opt_T, $opt_F, $opt_K); # the variables for getopt
278+
our ($opt_c, $opt_i, $opt_j, $opt_n, $opt_h, $opt_C, $opt_T, $opt_F, $opt_K, %defines); # the variables for getopt
264279
$opt_j = 0;
280+
GetOptions("D=s", \%defines);
265281
getopts('c:i:j:nhCTFK') or &main::HELP_MESSAGE(\*STDOUT, "", $main::VERSION, "");
266282
$opt_c or &main::HELP_MESSAGE(\*STDOUT, "", $main::VERSION, "");
267283
(!$opt_j || $has_thread_pool) or &main::HELP_MESSAGE(\*STDOUT, "", $main::VERSION, "");
@@ -298,15 +314,18 @@ ($)
298314
my @files = glob "$test/*.desc";
299315
for (0..$#files){
300316
defined($pool) or print " Running $files[$_]";
301-
$failed_skipped = test($test, $files[$_], $t_level, $opt_c, $opt_i, $dry_run);
317+
my $start_time = time();
318+
$failed_skipped = test(
319+
$test, $files[$_], $t_level, $opt_c, $opt_i, $dry_run, \%defines);
320+
my $runtime = time() - $start_time;
302321

303322
lock($skips);
304323
defined($pool) and print " Running $test $files[$_]";
305324
if(2 == $failed_skipped) {
306325
$skips++;
307326
print " [SKIPPED]\n";
308327
} elsif(0 == $failed_skipped) {
309-
print " [OK]\n";
328+
print " [OK] in $runtime seconds\n";
310329
} else {
311330
$failures++;
312331
print " [FAILED]\n";

0 commit comments

Comments
 (0)