Skip to content

Commit

Permalink
Add limit to number of parallel tests.
Browse files Browse the repository at this point in the history
git-svn-id: http://svn.perl.org/modules/dbd-oracle/trunk@506 50811bd7-b8ce-0310-adc1-d9db26280581
  • Loading branch information
timbo committed Oct 20, 2004
1 parent 54ae9a9 commit bd437b0
Showing 1 changed file with 27 additions and 15 deletions.
42 changes: 27 additions & 15 deletions mkta.pl
Original file line number Diff line number Diff line change
Expand Up @@ -17,13 +17,14 @@
s/^dbi:Oracle://i for @sid;

# set TEST_FILES env var to override which tests are run
my $opt_full = 0;
my $opt_full = 1;
my $opt_dir = "mkta";
my $opt_tf = $ENV{TEST_FILES};
my $opt_j = 6;

my $seq = 0;
my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
my (@run, %running, %skipped, @fail);
my (@queue, @run, %running, %skipped, @fail, $tested);

my @cs_utf8 = (ORA_OCI() < 9.2) ? ("UTF8") : ("AL32UTF8", ($opt_full) ? ("UTF8") : ());
my @cs_8bit = ($opt_full) ? ("WE8ISO8859P1", "WE8MSWIN1252") : ("WE8MSWIN1252");
Expand All @@ -39,6 +40,7 @@

sub mkta_sid_cs {
my ($sid, $charsets) = @_;
my $start_time = time;

local $ENV{ORACLE_SID} = $sid;
my $dbh = DBI->connect("dbi:Oracle:", $dbuser, undef, { PrintError=>0 });
Expand All @@ -56,23 +58,22 @@ sub mkta_sid_cs {

for my $ochar (@$charsets) {
for my $nchar (@$charsets) {
# because empty acts same as ochar
# because empty NLS_NCHAR is same as NLS_LANG charset
next if $nchar eq '' && $ochar ne '';
my ($tag, $fh) = start_test($sid, $ochar, $nchar);
push @queue, [ $sid, $ochar, $nchar ];
}
}
while (@queue) {
while (@queue && keys %running < $opt_j) {
my ($tag, $fh) = start_test(@{ shift @queue });
$running{$tag} = $fh;
push @run, $tag;
print "$tag: started\n";
++$tested;
}
wait_for_tests();
}
while(%running) {
my @running = grep { $running{$_} } @run;
my $tag = $running[0] or die;
close $running{ $tag };
printf "$tag: %s\n", ($?) ? "FAILED" : "pass";
push @fail, $tag if $?;
delete $running{$tag};
}
print "$sid: completed.\n";
wait_for_tests();
printf "$sid: completed in %.1f minutes\n", (time-$start_time)/60;
print "\n";
}

Expand All @@ -86,11 +87,22 @@ sub start_test {
my @make_opts;
push @make_opts, "TEST_FILES='$opt_tf'" if $opt_tf;
open $fh, "make test @make_opts > $opt_dir/$tag.log 2>&1 && rm $opt_dir/$tag.log |";
print "$tag: started\n";
return ($tag, $fh);
}

sub wait_for_tests {
while(%running) {
my @running = grep { $running{$_} } @run;
my $tag = $running[0] or die;
close $running{ $tag };
printf "$tag: %s\n", ($?) ? "FAILED" : "pass";
push @fail, $tag if $?;
delete $running{$tag};
}
}

print "Skipped due to $_: @{ $skipped{$_} }\n" for keys %skipped;

print "Failed: @fail\n" if @fail;
printf "Failed %d out of %d: @fail\n", scalar @fail, $tested;
print "done.\n"

0 comments on commit bd437b0

Please sign in to comment.