niceload: Fixed deepusleep bug introduced last month.

This commit is contained in:
Ole Tange 2014-10-25 12:44:10 +02:00
parent 2ff435caea
commit e38668f1f9
9 changed files with 55 additions and 108 deletions

View file

@ -166,7 +166,8 @@ git tag -s -m "Released as $YYYYMMDD ('$TAG')" $TAG
git tag -s -m "Released as $YYYYMMDD ('$TAG')" $YYYYMMDD
git push
git push origin $TAG
git push origin $YYYYMMDD
== Update documentation ==

View file

@ -239,13 +239,6 @@ sub usleep {
select(undef, undef, undef, $secs/1000);
}
sub deepusleep {
# Sleep this many milliseconds. Dont let children wake us up
my $sigchld = $SIG{'CHLD'};
$SIG{'CHLD'} = undef;
usleep(@_);
$SIG{'CHLD'} = $sigchld;
}
sub debug {
if($opt::debug) {
@ -616,7 +609,7 @@ sub sleep_for_recheck {
print STDERR "Sleeping $self->{'recheck'}s\n";
}
::debug("recheck in $self->{'recheck'}s\n");
::deepusleep(1000*$self->{'recheck'});
::usleep(1000*$self->{'recheck'});
}
@ -627,7 +620,7 @@ sub sleep_while_running {
$self->{'runtime'} = int($self->{'runtime'}*100)/100;
print STDERR "Running $self->{'runtime'}s\n";
}
::deepusleep(1000*$self->{'runtime'});
::usleep(1000*$self->{'runtime'});
}

View file

@ -1518,66 +1518,6 @@ sub shell_quote_file {
return $a;
}
sub _shellwords {
# '"'"'\""'"' foo\ bar\" '\" '\ quux => (q("'""), 'foo bar"', '\" quux');
my $s = shift;
# TODO: fails on " -v"
my (@words);
while($s =~ s{^
(
(
[^\\'"\s]+ | # Not quoted
'[^']*' | # '....' - inside '
\\. | # \? - quote single char
"( # Begin "
[^"\\]* | # Not quoted
(\\.)* # \? - quote single char
)*" # End "
)+
)
(\s+|$)
}{}xs
) {
# split into words
push @words, $1;
}
for my $w (@words) {
my @wordpart;
while($w =~ s{^
(
[^\\'"\s]+ | # Not quoted
'[^']*' | # '....' - inside '
\\. | # \? - quote single char
"( # Begin "
[^"\\]* | # Not quoted
(\\.)* # \? - quote single char
)*" # End "
) }{}xs) {
my $wp = $1;
while($wp =~ s{^
([^\\'"\s]+) | # Not quoted
'([^']*)' | # '....' - inside '
\\(.) | # \? - quote single char
"( # Begin "
[^"\\]* | # Not quoted
(\\.)* # \? - quote single char
)*" # End "
}{}xs) {
push @wordpart, $1, $2, $3;
my $doubleq = $4;
while($doubleq =~ s{^
([^"\\]+) | # Not quoted
\\(.) # \? - quote single char
}{}x) {
push @wordpart, $1, $2;
}
}
}
$w = join("",@wordpart);
}
return @words;
}
sub shellwords {
# Input:
# $string = shell line
@ -3131,7 +3071,6 @@ sub which {
q(s/^.{$s}//; print "@F[1,2] $_"' );
# BSD-style `ps`
my $bsd = q(ps -o pid,ppid,command -ax);
# TODO test these on Cygwin, darwin
%pid_parentpid_cmd =
(
'aix' => $sysv,
@ -5242,13 +5181,23 @@ sub set_endtime {
}
sub timedout {
# Is the job timedout?
# Input:
# $delta_time = time that the job may run
# Returns:
# True or false
my $self = shift;
my $delta_time = shift;
return time > $self->{'starttime'} + $delta_time;
}
sub kill {
# kill the jobs
# Kill the job.
# Send the signals to (grand)*children and pid.
# If no signals: TERM TERM KILL
# Wait 200 ms after each TERM.
# Input:
# @signals = signals to send
my $self = shift;
my @signals = @_;
my @family_pids = $self->family_pids();
@ -5280,10 +5229,10 @@ sub kill {
}
}
sub family_pids {
# Find the pids with this->pid as (grand)*parent
# Returns:
# @pids = pids of (grand)*children
my $self = shift;
my $pid = $self->pid();
my @pids;
@ -5308,6 +5257,10 @@ sub family_pids {
sub failed {
# return number of times failed for this $sshlogin
# Input:
# $sshlogin
# Returns:
# Number of times failed for $sshlogin
my $self = shift;
my $sshlogin = shift;
return $self->{'failed'}{$sshlogin};
@ -5315,6 +5268,8 @@ sub failed {
sub failed_here {
# return number of times failed for the current $sshlogin
# Returns:
# Number of times failed for this sshlogin
my $self = shift;
return $self->{'failed'}{$self->sshlogin()};
}
@ -5358,13 +5313,13 @@ sub min_failed {
sub total_failed {
# Returns:
# the number of times this command has failed
# $total_failures = the number of times this command has failed
my $self = shift;
my $total_failures = 0;
for (values %{$self->{'failed'}}) {
$total_failures += $_;
}
return ($total_failures);
return $total_failures;
}
sub wrapped {
@ -5463,6 +5418,7 @@ sub set_sshlogin {
my $sshlogin = shift;
$self->{'sshlogin'} = $sshlogin;
delete $self->{'sshlogin_wrap'}; # If sshlogin is changed the wrap is wrong
delete $self->{'wrapped'};
}
sub sshlogin {

View file

@ -41,8 +41,8 @@ echo '### Bug before 2009-08-26 causing regexp compile error or infinite loop (I
echo a | parallel -qX echo "'{}'"
echo '### bug #42041: Implement $PARALLEL_JOBSLOT'
parallel -k --slotreplace // -j2 sleep 1\;echo // ::: {1..4}
parallel -k -j2 sleep 1\;echo {%} ::: {1..4}
parallel -k --slotreplace // -j2 sleep 1\;echo // ::: {1..4} | sort
parallel -k -j2 sleep 1\;echo {%} ::: {1..4} | sort
echo '### bug #42363: --pipepart and --fifo/--cat does not work'
seq 100 > /tmp/bug42363;

View file

@ -1,7 +1,7 @@
#!/bin/bash
echo '### Test -k'
ulimit -n 70
ulimit -n 50
(echo "sleep 3; echo begin"; seq 1 30 | parallel -kq echo "sleep 1; echo {}"; echo "echo end") \
| stdout parallel -k -j0

View file

@ -122,6 +122,6 @@ stdout ssh $SSHLOGIN1 ls 'tmp/parallel.file*' || echo OK
# Should give: No such file or directory
stdout ssh $SSHLOGIN2 ls 'tmp/parallel.file*' || echo OK
echo 'Input for ssh'
cat /tmp/myssh1-run /tmp/myssh2-run | perl -pe 's/(PID.)\d+/${1}00000/g'
cat /tmp/myssh1-run /tmp/myssh2-run | perl -pe 's/(PID.)\d+/${1}00000/g;s/(SEQ[ =]|line)\d/$1X/g;'
rm /tmp/myssh1-run /tmp/myssh2-run

View file

@ -1,9 +1,6 @@
### Tests from xargs
parallel: Warning: Only enough file handles to run 248 jobs in parallel.
Running 'parallel -j0 -N248 --pipe parallel -j0' or raising ulimit -n or /etc/security/limits.conf may help.
echo '### -0 -n3 echo < files0.xi'
### -0 -n3 echo < files0.xi
parallel: Warning: No more file handles. Raising ulimit -n or /etc/security/limits.conf may help.
stdout xargs -0 -n3 echo < files0.xi
/src/gnu/autoconf-1.11 /src/gnu/autoconf-1.11/README /src/gnu/autoconf-1.11/Makefile.in
/src/gnu/autoconf-1.11/INSTALL /src/gnu/autoconf-1.11/NEWS /src/gnu/autoconf-1.11/COPYING

View file

@ -31,15 +31,15 @@ echo '### Bug before 2009-08-26 causing regexp compile error or infinite loop (I
'a'
echo '### bug #42041: Implement $PARALLEL_JOBSLOT'
### bug #42041: Implement $PARALLEL_JOBSLOT
parallel -k --slotreplace // -j2 sleep 1\;echo // ::: {1..4}
parallel -k --slotreplace // -j2 sleep 1\;echo // ::: {1..4} | sort
1
1
2
2
parallel -k -j2 sleep 1\;echo {%} ::: {1..4} | sort
1
1
2
parallel -k -j2 sleep 1\;echo {%} ::: {1..4}
1
2
1
2
echo '### bug #42363: --pipepart and --fifo/--cat does not work'
### bug #42363: --pipepart and --fifo/--cat does not work

View file

@ -77,35 +77,35 @@ OK
Input for ssh
parallel@parallel-server1 mkdir -p ./.
-l parallel parallel-server1 rsync --server -lDrRze.iLsfx . ./.
-tt -oLogLevel=quiet parallel@parallel-server1 eval `echo $SHELL | grep "/t\{0,1\}csh" > /dev/null && echo setenv PARALLEL_SEQ 1\; setenv PARALLEL_PID 00000 || echo PARALLEL_SEQ=1\;export PARALLEL_SEQ\; PARALLEL_PID=00000\;export PARALLEL_PID` ; tty >/dev/null && stty isig -onlcr -echo;cat tmp/parallel.file.'
'newline1 > tmp/parallel.file.'
'newline1.out;cat tmp/parallel.file.'
'newline1 > tmp/parallel.file.'
'newline1.out2
-tt -oLogLevel=quiet parallel@parallel-server1 eval `echo $SHELL | grep "/t\{0,1\}csh" > /dev/null && echo setenv PARALLEL_SEQ X\; setenv PARALLEL_PID 00000 || echo PARALLEL_SEQ=X\;export PARALLEL_SEQ\; PARALLEL_PID=00000\;export PARALLEL_PID` ; tty >/dev/null && stty isig -onlcr -echo;cat tmp/parallel.file.'
'newlineX > tmp/parallel.file.'
'newlineX.out;cat tmp/parallel.file.'
'newlineX > tmp/parallel.file.'
'newlineX.out2
-l parallel parallel-server1 cd ././tmp; rsync --server --sender -lDrRze.iLsfx . ./parallel.file.'
'newline1.out
'newlineX.out
-l parallel parallel-server1 cd ././tmp; rsync --server --sender -lDrRze.iLsfx . ./parallel.file.'
'newline1.out2
'newlineX.out2
parallel@parallel-server1 (rm -f ./tmp/parallel.file.'
'newline1; rmdir ./tmp/ ./ 2>/dev/null;)
'newlineX; rmdir ./tmp/ ./ 2>/dev/null;)
parallel@parallel-server1 (rm -f ./tmp/parallel.file.'
'newline1.out; rmdir ./tmp/ ./ 2>/dev/null;)
'newlineX.out; rmdir ./tmp/ ./ 2>/dev/null;)
parallel@parallel-server1 (rm -f ./tmp/parallel.file.'
'newline1.out2; rmdir ./tmp/ ./ 2>/dev/null;)
'newlineX.out2; rmdir ./tmp/ ./ 2>/dev/null;)
parallel@parallel-server2 mkdir -p ./.
-l parallel parallel-server2 rsync --server -lDrRze.iLsfx . ./.
-tt -oLogLevel=quiet parallel@parallel-server2 eval `echo $SHELL | grep "/t\{0,1\}csh" > /dev/null && echo setenv PARALLEL_SEQ 2\; setenv PARALLEL_PID 00000 || echo PARALLEL_SEQ=2\;export PARALLEL_SEQ\; PARALLEL_PID=00000\;export PARALLEL_PID` ; tty >/dev/null && stty isig -onlcr -echo;cat tmp/parallel.file.'
'newline2 > tmp/parallel.file.'
'newline2.out;cat tmp/parallel.file.'
'newline2 > tmp/parallel.file.'
'newline2.out2
-tt -oLogLevel=quiet parallel@parallel-server2 eval `echo $SHELL | grep "/t\{0,1\}csh" > /dev/null && echo setenv PARALLEL_SEQ X\; setenv PARALLEL_PID 00000 || echo PARALLEL_SEQ=X\;export PARALLEL_SEQ\; PARALLEL_PID=00000\;export PARALLEL_PID` ; tty >/dev/null && stty isig -onlcr -echo;cat tmp/parallel.file.'
'newlineX > tmp/parallel.file.'
'newlineX.out;cat tmp/parallel.file.'
'newlineX > tmp/parallel.file.'
'newlineX.out2
-l parallel parallel-server2 cd ././tmp; rsync --server --sender -lDrRze.iLsfx . ./parallel.file.'
'newline2.out
'newlineX.out
-l parallel parallel-server2 cd ././tmp; rsync --server --sender -lDrRze.iLsfx . ./parallel.file.'
'newline2.out2
'newlineX.out2
parallel@parallel-server2 (rm -f ./tmp/parallel.file.'
'newline2; rmdir ./tmp/ ./ 2>/dev/null;)
'newlineX; rmdir ./tmp/ ./ 2>/dev/null;)
parallel@parallel-server2 (rm -f ./tmp/parallel.file.'
'newline2.out; rmdir ./tmp/ ./ 2>/dev/null;)
'newlineX.out; rmdir ./tmp/ ./ 2>/dev/null;)
parallel@parallel-server2 (rm -f ./tmp/parallel.file.'
'newline2.out2; rmdir ./tmp/ ./ 2>/dev/null;)
'newlineX.out2; rmdir ./tmp/ ./ 2>/dev/null;)