tange/parallel
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/parallel.git synced 2024-11-22 14:07:55 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

parallel: Now passes test32. test34 has an insignificant warning.

Browse source
This commit is contained in:
Ole Tange 2010-11-28 02:09:53 +01:00
parent ae08cc3b1c
commit 16bf961945
1 changed files with 18 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
src/parallel
View file

@ -3771,7 +3771,7 @@ sub start_more_jobs {
for my $sshlogin (values %Global::host) { for my $sshlogin (values %Global::host) {
debug("Running jobs on ".$sshlogin->string().": ".$sshlogin->jobs_running()."\n"); debug("Running jobs on ".$sshlogin->string().": ".$sshlogin->jobs_running()."\n");
while ($sshlogin->jobs_running() < $sshlogin->max_jobs_running()) { while ($sshlogin->jobs_running() < $sshlogin->max_jobs_running()) {
if($Global::CommandLineQueue->empty()) { if($Global::JobQueue->empty()) {
last; last;
} }
debug("Try starting a job on ".$sshlogin->string()."\n"); debug("Try starting a job on ".$sshlogin->string()."\n");
@ -3796,9 +3796,11 @@ sub start_another_job {
# 1 if another jobs was started # 1 if another jobs was started
# 0 otherwise # 0 otherwise
my $sshlogin = shift; my $sshlogin = shift;
# ::my_dump($sshlogin);
# ::my_dump($Global::JobQueue);
# Do we have enough file handles to start another job? # Do we have enough file handles to start another job?
if(enough_file_handles()) { if(enough_file_handles()) {
if($Global::CommandLineQueue->empty()) { if($Global::JobQueue->empty()) {
# No more commands to run # No more commands to run
return 0; return 0;
} else { } else {
@ -3835,7 +3837,7 @@ sub get_job_with_sshlogin {
# next command to run with no wrapping (clean_command) # next command to run with no wrapping (clean_command)
my $sshlogin = shift; my $sshlogin = shift;
if($::oodebug and $Global::CommandLineQueue->empty()) { if($::oodebug and $Global::JobQueue->empty()) {
Carp::confess("get_job_with_sshlogin should never be called if empty"); Carp::confess("get_job_with_sshlogin should never be called if empty");
} }
@ -3852,7 +3854,7 @@ sub get_job_with_sshlogin {
my ($clean_command) = $next_command_line; my ($clean_command) = $next_command_line;
if($clean_command =~ /^\s*$/) { if($clean_command =~ /^\s*$/) {
# Do not run empty lines # Do not run empty lines
if(not $Global::CommandLineQueue->empty()) { if(not $Global::JobQueue->empty()) {
return get_job_with_sshlogin($sshlogin); return get_job_with_sshlogin($sshlogin);
} else { } else {
return undef; return undef;
@ -3862,8 +3864,9 @@ sub get_job_with_sshlogin {
if($::opt_retries and $clean_command and if($::opt_retries and $clean_command and
$job->failed_here()) { $job->failed_here()) {
# This command with these args failed for this sshlogin # This command with these args failed for this sshlogin
my ($no_of_failed_sshlogins,$min_failures) = $job->min_failures(); my ($no_of_failed_sshlogins,$min_failures) = $job->min_failed();
if($no_of_failed_sshlogins < keys %Global::host or #::my_dump(($no_of_failed_sshlogins,$min_failures));
if($no_of_failed_sshlogins == keys %Global::host and
$job->failed_here() == $min_failures) { $job->failed_here() == $min_failures) {
# It failed the same or more times on another host: # It failed the same or more times on another host:
# run it on this host # run it on this host
@ -3928,7 +3931,7 @@ sub parse_sshlogin {
$Global::host{$sshlogin_string}->set_jobs_running(0); $Global::host{$sshlogin_string}->set_jobs_running(0);
$Global::host{$sshlogin_string}->set_maxlength(Limits::Command::max_length()); $Global::host{$sshlogin_string}->set_maxlength(Limits::Command::max_length());
} }
debug("sshlogin: ", my_dump(%Global::host),"\n"); #debug("sshlogin: ", my_dump(%Global::host),"\n");
if($::opt_transfer or @::opt_return or $::opt_cleanup or @::opt_basefile) { if($::opt_transfer or @::opt_return or $::opt_cleanup or @::opt_basefile) {
if(not remote_hosts()) { if(not remote_hosts()) {
# There are no remote hosts # There are no remote hosts
@ -4095,8 +4098,9 @@ sub reaper {
$retry_job = 0; $retry_job = 0;
} else { } else {
# This command should be retried # This command should be retried
$Global::CommandLineQueue->unget($job); $Global::JobQueue->unget($job);
$retry_job = 1; $retry_job = 1;
::debug("Retry ".$job->seq()."\n");
} }
} }
} }
@ -4752,7 +4756,7 @@ sub min_failed {
# the minimal number of times this command has failed # the minimal number of times this command has failed
my $self = shift; my $self = shift;
my $min_failures = my $min_failures =
min(map { $self->{'failed'}{$_} } ::min(map { $self->{'failed'}{$_} }
keys %{$self->{'failed'}}); keys %{$self->{'failed'}});
my $number_of_sshlogins_failed_on = scalar keys %{$self->{'failed'}}; my $number_of_sshlogins_failed_on = scalar keys %{$self->{'failed'}};
return ($number_of_sshlogins_failed_on,$min_failures); return ($number_of_sshlogins_failed_on,$min_failures);
@ -4773,6 +4777,7 @@ sub set_sshlogin {
my $self = shift; my $self = shift;
my $sshlogin = shift; my $sshlogin = shift;
$self->{'sshlogin'} = $sshlogin; $self->{'sshlogin'} = $sshlogin;
delete $self->{'sshlogin_wrap'}; # If sshlogin is changed the wrap is wrong
} }
sub sshlogin { sub sshlogin {
@ -4999,6 +5004,10 @@ sub start {
# Returns: # Returns:
# job-object or undef if job not to run # job-object or undef if job not to run
my $job = shift; my $job = shift;
if($::oodebug and $job->{'commandline'}->{'commandline'}) {
Carp::confess($job);
die "jkj2";
}
# my $commandline = $job->{'commandline'}; # my $commandline = $job->{'commandline'};
my $command = $job->sshlogin_wrap(); my $command = $job->sshlogin_wrap();
# my $clean_command = $commandline->replaced(); # my $clean_command = $commandline->replaced();
@ -5085,7 +5094,6 @@ sub start {
or die "Can't dup \$Global::original_stdout: $!"; or die "Can't dup \$Global::original_stdout: $!";
open STDERR, ">&", $Global::original_stderr open STDERR, ">&", $Global::original_stderr
or die "Can't dup \$Global::original_stderr: $!"; or die "Can't dup \$Global::original_stderr: $!";
::debug("started: $command\n");
return $job; return $job;
} }