Passes testsuite.

This commit is contained in:
Ole Tange 2015-06-21 19:40:58 +02:00
parent cb20cd2c8e
commit 6d3892ff84
7 changed files with 99 additions and 149 deletions

View file

@ -1649,13 +1649,6 @@ sub shell_quote {
: (join" ",map { shell_quote_scalar($_) } @_);
}
sub shell_quote_scalar {
# Quote the string so the shell will not expand any special chars
# Inputs:
# $string = string to be quoted
# Returns:
# $shell_quoted = string quoted as needed by the shell
sub shell_quote_scalar_rc {
# Quote for the rc-shell
my $a = $_[0];
@ -1718,6 +1711,13 @@ sub shell_quote_scalar {
return $a;
}
sub shell_quote_scalar {
# Quote the string so the shell will not expand any special chars
# Inputs:
# $string = string to be quoted
# Returns:
# $shell_quoted = string quoted as needed by the shell
# Speed optimization: Choose the correct shell_quote_scalar_*
# and call that directly from now on
no warnings 'redefine';
@ -6963,110 +6963,97 @@ sub parentdirs_of {
return @parents;
}
sub open3_setpgrp_external {
my ($in,$command) = @_;
my $pid;
my @setpgrp_wrap = ('perl','-e',"setpgrp\;exec '$Global::shell', '-c', \@ARGV");
# The eval is needed to catch exception from open3
eval {
$pid = ::open3($in, ">&OUT", ">&ERR", @setpgrp_wrap, $command)
|| ::die_bug("open3-$in");
1;
};
return $pid;
}
sub open3_setpgrp_internal {
my ($in,$command) = @_;
my $pid;
# The eval is needed to catch exception from open3
eval {
if(not $pid = ::open3($in, ">&OUT", ">&ERR", "-")) {
# Each child gets its own process group to make it safe to killall
setpgrp(0,0);
exec("exec $Global::shell -c ".::shell_quote_scalar($command))
|| ::die_bug("open3-$in $command");
}
};
return $pid;
}
sub open3_setpgrp {
# If the OS supports open3(x,x,x,"-") use that
eval{ ::open3(Symbol::gensym(), ">&STDOUT", ">&STDERR", "-")};
# if($@) {
if(1) {
# Does not support open3(x,x,x,"-")
*open3_setpgrp = \&open3_setpgrp_external;
} else {
# Supports open3(x,x,x,"-")
*open3_setpgrp = \&open3_setpgrp_internal;
}
# The sub is now redefined. Call it
return open3_setpgrp(@_);
}
sub start {
# Setup STDOUT and STDERR for a job and start it.
# Returns:
# job-object or undef if job not to run
sub open3_setpgrp_internal {
# Input:
# $stdin_fh = Filehandle to use as STDIN
# $stdout_fh = Filehandle to use as STDOUT
# $stderr_fh = Filehandle to use as STDERR
# $command = Command to run
# Returns:
# $pid = Process group of job started
my ($stdin_fh,$stdout_fh,$stderr_fh,$command) = @_;
my $pid;
local (*OUT,*ERR);
open OUT, '>&', $stdout_fh or ::die_bug("Can't dup STDOUT: $!");
open ERR, '>&', $stderr_fh or ::die_bug("Can't dup STDERR: $!");
# The eval is needed to catch exception from open3
eval {
if(not $pid = ::open3($stdin_fh, ">&OUT", ">&ERR", "-")) {
# Each child gets its own process group to make it safe to killall
setpgrp(0,0);
exec("exec $Global::shell -c ".::shell_quote_scalar_default($command))
|| ::die_bug("open3-$stdin_fh $command");
}
};
return $pid;
}
sub open3_setpgrp {
my ($stdin_fh,$stdout_fh,$stderr_fh,$command) = @_;
local (*IN,*OUT,*ERR);
if(fileno $stdin_fh) {
# $stdin_fh is a file handle, not a gensym
open IN, '<&', $stdin_fh or ::die_bug("Can't dup STDIN: $!");
$stdin_fh = *IN;
}
open OUT, '>&', $stdout_fh or ::die_bug("Can't dup STDOUT: $!");
open ERR, '>&', $stderr_fh or ::die_bug("Can't dup STDERR: $!");
my $pid;
my @setpgrp_wrap = ('perl','-e',"setpgrp\;exec '$Global::shell', '-c', \@ARGV");
# The eval is needed to catch exception from open3
eval {
$pid = ::open3($stdin_fh, ">&OUT", ">&ERR", @setpgrp_wrap, $command)
|| ::die_bug("open3-$stdin_fh");
1;
};
return $pid;
}
my $job = shift;
# Get the shell command to be executed (possibly with ssh infront).
my $command = $job->wrapped();
my $pid;
if($Global::interactive or $Global::stderr_verbose) {
$command = interactive_start($command);
}
$job->openoutputfiles();
my($stdout_fh,$stderr_fh) = ($job->fh(1,"w"),$job->fh(2,"w"));
local (*IN,*OUT,*ERR);
open OUT, '>&', $stdout_fh or ::die_bug("Can't redirect STDOUT: $!");
open ERR, '>&', $stderr_fh or ::die_bug("Can't dup STDOUT: $!");
if($opt::ungroup) {
print_dryrun_and_verbose($stdout_fh,$job,$command);
}
if($opt::dryrun) {
$command = "true";
}
if($opt::dryrun) { $command = "true"; }
$ENV{'PARALLEL_SEQ'} = $job->seq();
$ENV{'PARALLEL_PID'} = $$;
$ENV{'PARALLEL_TMP'} = ::tmpname("par");
::debug("run", $Global::total_running, " processes . Starting (",
$job->seq(), "): $command\n");
$command = "exec $Global::shell -c ".::shell_quote_scalar($command);
if($opt::pipe) {
my ($stdin_fh);
# $pid = open3_setpgrp($stdin_fh,$command);
# $pid = open3_setpgrp($stdin_fh,$command);
# The eval is needed to catch exception from open3
my @setpgrp_wrap = ('perl','-e',"setpgrp\;exec '$Global::shell', '-c', \@ARGV");
# The eval is needed to catch exception from open3
eval {
$pid = ::open3($stdin_fh, ">&OUT", ">&ERR", @setpgrp_wrap, $command)
|| ::die_bug("open3-stdin");
1;
};
# eval {
# if(not $pid = ::open3($stdin_fh, ">&OUT", ">&ERR", "-")) {
# # Each child gets its own process group to make it safe to killall
# setpgrp(0,0);
# exec($command) || ::die_bug("open3-pipe");
# }
# 1;
# };
my ($stdin_fh) = ::gensym();
$pid = open3_setpgrp($stdin_fh,$stdout_fh,$stderr_fh,$command);
$job->set_fh(0,"w",$stdin_fh);
} elsif ($opt::tty and not $Global::tty_taken and -c "/dev/tty" and
open(my $devtty_fh, "<", "/dev/tty")) {
# Give /dev/tty to the command if no one else is using it
*IN = $devtty_fh;
# The eval is needed to catch exception from open3
eval {
$pid = ::open3("<&IN", ">&OUT", ">&ERR", $command) ||
::die_bug("open3-/dev/tty");
no warnings;
local(*IN) = $devtty_fh;
local (*OUT,*ERR);
open OUT, '>&', $stdout_fh or ::die_bug("Can't dup STDOUT: $!");
open ERR, '>&', $stderr_fh or ::die_bug("Can't dup STDERR: $!");
$pid = ::open3("<&IN", ">&OUT", ">&ERR",
"exec $Global::shell -c ".::shell_quote_scalar_default($command)) ||
::die_bug("open3-/dev/tty");
$Global::tty_taken = $pid;
close $devtty_fh;
1;
@ -7075,47 +7062,22 @@ sub start {
and $job->sshlogin()->string() eq ":") {
# Give STDIN to the first job if using -a (but only if running
# locally - otherwise CTRL-C does not work for other jobs Bug#36585)
local (*IN,*OUT,*ERR);
open OUT, '>&', $stdout_fh or ::die_bug("Can't dup STDOUT: $!");
open ERR, '>&', $stderr_fh or ::die_bug("Can't dup STDERR: $!");
*IN = *STDIN;
# $pid = open3_setpgrp_internal("<&IN",$command);
# $pid = open3_setpgrp("<&IN",$command);
# The eval is needed to catch exception from open3
my @setpgrp_wrap = ('perl','-e',"setpgrp\;exec '$Global::shell', '-c', \@ARGV");
# The eval is needed to catch exception from open3
eval {
$pid = ::open3("<&IN", ">&OUT", ">&ERR", @setpgrp_wrap, $command)
|| ::die_bug("open3-IN");
1;
};
# eval {
# if(not $pid = ::open3("<&IN", ">&OUT", ">&ERR", "-")) {
# # Each child gets its own process group to make it safe to killall
# setpgrp(0,0);
# exec($command) || ::die_bug("open3-a");
# }
# 1;
# };
my @setpgrp_wrap = ('perl','-e',"setpgrp\;exec '$Global::shell', '-c', \@ARGV");
eval {
$pid = ::open3("<&IN", ">&OUT", ">&ERR", @setpgrp_wrap, $command)
|| ::die_bug("open3-<IN");
1;
};
# Re-open to avoid complaining
open(STDIN, "<&", $Global::original_stdin)
or ::die_bug("dup-\$Global::original_stdin: $!");
} else {
# $pid = open3_setpgrp_internal(::gensym,$command);
# $pid = open3_setpgrp(::gensym,$command);
# The eval is needed to catch exception from open3
my @setpgrp_wrap = ('perl','-e',"setpgrp\;exec '$Global::shell', '-c', \@ARGV");
# The eval is needed to catch exception from open3
eval {
$pid = ::open3(::gensym, ">&OUT", ">&ERR", @setpgrp_wrap, $command)
|| ::die_bug("open3-gens");
1;
};
# eval {
# if(not $pid = ::open3(::gensym, ">&OUT", ">&ERR", "-")) {
# # Each child gets its own process group to make it safe to killall
# setpgrp(0,0);
# exec($command) || ::die_bug("open3-gensym $command");
# }
# 1;
# };
$pid = open3_setpgrp(::gensym(),$stdout_fh,$stderr_fh,$command);
}
if($pid) {
# A job was started
@ -7227,8 +7189,8 @@ sub print_dryrun_and_verbose {
$tmuxsocket = ::tmpname("tms");
::status("See output with: $ENV{'TMUX'} -S $tmuxsocket attach\n");
}
# TODO sh -c wrapper for >&
$tmux = $ENV{'TMUX'}." -S $tmuxsocket new-session -s p$$ -d 'sleep .2' >&/dev/null;" .
$tmux = "sh -c '".
$ENV{'TMUX'}." -S $tmuxsocket new-session -s p$$ -d \"sleep .2\" >/dev/null 2>&1';" .
$ENV{'TMUX'}." -S $tmuxsocket new-window -t p$$ -n $title";
::debug("tmux", "title len:", $l_tit, " act ", $l_act, " max ",
@ -7394,7 +7356,7 @@ sub print {
}
::debug("print", "<<joboutput @command\n");
if($Global::joblog and defined $self->{'exitstatus'}
and not ($self->virgin() and $opt::pipe)) {
and not ($self->virgin() and $opt::pipe)) {
# Add to joblog when finished
$self->print_joblog();
}

View file

@ -39,9 +39,9 @@ export -f run_test
# Create a monitor script
echo forever pstree -lp $$ >/tmp/monitor
chmod 755 /tmp/monitor
# log rotate
parallel -j1 mv testsuite.log.{} testsuite.log.'{= $_++ =}' ::: 10 9 8 7 6 5 4 3 2 1
mv testsuite.log testsuite.log.1
# Log rotate
seq 10 -1 1 | parallel -j1 mv log/testsuite.log.{} log/testsuite.log.'{= $_++ =}'
mv testsuite.log log/testsuite.log.1
date
mkdir -p actual-results
ls -t tests-to-run/*${1}*.sh | egrep -v "${2}" |

View file

@ -18,7 +18,7 @@ echo '### csh'
setenv B `seq 200 -1 1|xargs`;
setenv C `seq 300 -2 1|xargs`;
parallel -Scsh@lo --env A,B,C -k echo \$\{\}\|wc ::: A B C'
echo '### csh2'
echo "3 big vars run locally"
stdout ssh csh@lo 'setenv A `seq 200|xargs`;
setenv B `seq 200 -1 1|xargs`;
@ -35,12 +35,9 @@ echo '### Test tmux works on different shells'
stdout ssh parallel@lo "$PARTMUX" 'true ::: 1 2 3 4; echo $?' | grep -v 'See output';
stdout ssh parallel@lo "$PARTMUX" 'false ::: 1 2 3 4; echo $?' | grep -v 'See output';
stdout ssh tcsh@lo "$PARTMUX" 'true ::: 1 2 3 4; echo $status' | grep -v 'See output';
stdout ssh tcsh@lo "$PARTMUX" 'false ::: 1 2 3 4; echo $status' | grep -v 'See output'
echo '### This fails - word too long'
export PARTMUX='parallel -Scsh@lo,tcsh@lo,parallel@lo,zsh@lo --tmux ';
stdout ssh csh@lo "$PARTMUX" 'true ::: 1 2 3 4; echo $status' | grep -v 'See output';
stdout ssh csh@lo "$PARTMUX" 'false ::: 1 2 3 4; echo $status' | grep -v 'See output'
stdout ssh tcsh@lo "$PARTMUX" 'false ::: 1 2 3 4; echo $status' | grep -v 'See output';
stdout ssh csh@lo "$PARTMUX" 'true ::: 1 2 3 4; echo $status' | grep -v 'See output';
stdout ssh csh@lo "$PARTMUX" 'false ::: 1 2 3 4; echo $status' | grep -v 'See output'
echo '### works'
stdout parallel -Sparallel@lo --tmux echo ::: \\\\\\\"\\\\\\\"\\\;\@ | grep -v 'See output'

View file

@ -22,7 +22,7 @@ perl -ne '$/="\n\n"; /^Output/../^[^O]\S/ and next; /^ / and print;' ../../src/
# When parallelized: Sleep to make sure the abc-files are made
/%head1/ and $_.="sleep .3\n\n"x10;
' |
stdout parallel -j7 -vd'\n\n' |
stdout parallel --joblog /tmp/jl-`basename $0` -j7 -vd'\n\n' |
perl -pe '$|=1;
# --tmux
s:(/tmp\S+)(tms).....:$1$2XXXXX:;

View file

@ -359,8 +359,12 @@ pdksh "#&/
pdksh ()*=?'
posh "#&/
posh ()*=?'
rbash "#&/
rbash ()*=?'
rc "#&/
rc ()*=?'
rzsh "#&/
rzsh ()*=?'
sash "#&/
sash ()*=?'
sh "#&/
@ -373,8 +377,6 @@ yash "#&/
yash ()*=?'
zsh "#&/
zsh ()*=?'
rbash rbash: line 0: exec: restricted
rzsh zsh:exec:1: rzsh: restricted
echo '**'
**
### 1 .par file from --files expected

View file

@ -8,13 +8,15 @@ echo '### csh'
### csh
echo "3 big vars run remotely - length(base64) > 1000"
3 big vars run remotely - length(base64) > 1000
stdout ssh csh@lo 'setenv A `seq 200|xargs`; setenv B `seq 200 -1 1|xargs`; setenv C `seq 300 -2 1|xargs`; parallel -Scsh@lo --env A,B,C -k echo \$\{\}\|wc ::: A B C'
stdout ssh csh@lo 'setenv A `seq 200|xargs`; setenv B `seq 200 -1 1|xargs`; setenv C `seq 300 -2 1|xargs`; parallel -Scsh@lo --env A,B,C -k echo \$\{\}\|wc ::: A B C'
1 200 692
1 200 692
1 150 547
echo '### csh2'
### csh2
echo "3 big vars run locally"
3 big vars run locally
stdout ssh csh@lo 'setenv A `seq 200|xargs`; setenv B `seq 200 -1 1|xargs`; setenv C `seq 300 -2 1|xargs`; parallel --env A,B,C -k echo \$\{\}\|wc ::: A B C'
stdout ssh csh@lo 'setenv A `seq 200|xargs`; setenv B `seq 200 -1 1|xargs`; setenv C `seq 300 -2 1|xargs`; parallel --env A,B,C -k echo \$\{\}\|wc ::: A B C'
1 200 692
1 200 692
1 150 547
@ -24,25 +26,14 @@ echo '### Test tmux works on different shells'
0
parallel -Scsh@lo,tcsh@lo,parallel@lo,zsh@lo --tmux false ::: 1 2 3 4; echo $?
4
export PARTMUX='parallel -Scsh@lo,tcsh@lo,parallel@lo,zsh@lo --tmux '; stdout ssh zsh@lo "$PARTMUX" 'true ::: 1 2 3 4; echo $status' | grep -v 'See output'; stdout ssh zsh@lo "$PARTMUX" 'false ::: 1 2 3 4; echo $status' | grep -v 'See output'; stdout ssh parallel@lo "$PARTMUX" 'true ::: 1 2 3 4; echo $?' | grep -v 'See output'; stdout ssh parallel@lo "$PARTMUX" 'false ::: 1 2 3 4; echo $?' | grep -v 'See output'; stdout ssh tcsh@lo "$PARTMUX" 'true ::: 1 2 3 4; echo $status' | grep -v 'See output'; stdout ssh tcsh@lo "$PARTMUX" 'false ::: 1 2 3 4; echo $status' | grep -v 'See output'
export PARTMUX='parallel -Scsh@lo,tcsh@lo,parallel@lo,zsh@lo --tmux '; stdout ssh zsh@lo "$PARTMUX" 'true ::: 1 2 3 4; echo $status' | grep -v 'See output'; stdout ssh zsh@lo "$PARTMUX" 'false ::: 1 2 3 4; echo $status' | grep -v 'See output'; stdout ssh parallel@lo "$PARTMUX" 'true ::: 1 2 3 4; echo $?' | grep -v 'See output'; stdout ssh parallel@lo "$PARTMUX" 'false ::: 1 2 3 4; echo $?' | grep -v 'See output'; stdout ssh tcsh@lo "$PARTMUX" 'true ::: 1 2 3 4; echo $status' | grep -v 'See output'; stdout ssh tcsh@lo "$PARTMUX" 'false ::: 1 2 3 4; echo $status' | grep -v 'See output'; stdout ssh csh@lo "$PARTMUX" 'true ::: 1 2 3 4; echo $status' | grep -v 'See output'; stdout ssh csh@lo "$PARTMUX" 'false ::: 1 2 3 4; echo $status' | grep -v 'See output'
0
4
0
4
0
4
echo '### This fails - word too long'
### This fails - word too long
export PARTMUX='parallel -Scsh@lo,tcsh@lo,parallel@lo,zsh@lo --tmux '; stdout ssh csh@lo "$PARTMUX" 'true ::: 1 2 3 4; echo $status' | grep -v 'See output'; stdout ssh csh@lo "$PARTMUX" 'false ::: 1 2 3 4; echo $status' | grep -v 'See output'
Word too long.
Word too long.
Word too long.
Word too long.
4
Word too long.
Word too long.
Word too long.
Word too long.
0
4
echo '### works'
### works

View file

@ -191,10 +191,8 @@ which static-sh => shell path /bin/static-sh
which tcsh => shell path /usr/bin/tcsh
which yash => shell path /usr/bin/yash
which zsh => shell path /usr/bin/zsh
/bin/rbash: line 0: exec: restricted
Local configuration error occurred.
Contact the systems administrator for further assistance.
zsh:exec:1: /bin/rzsh: restricted
echo '## Started directly from perl'
## Started directly from perl
perl -e 'system(qw(parallel -Dinit echo ::: 1))' | grep which; rm -f /tmp/par*.par