From 6d3892ff84e292a46b43c7fb93411779523cac64 Mon Sep 17 00:00:00 2001 From: Ole Tange Date: Sun, 21 Jun 2015 19:40:58 +0200 Subject: [PATCH] Passes testsuite. --- src/parallel | 200 +++++++----------- testsuite/Start.sh | 6 +- testsuite/tests-to-run/parallel-local-ssh4.sh | 11 +- testsuite/tests-to-run/parallel-tutorial.sh | 2 +- testsuite/wanted-results/parallel-local-0.3s | 6 +- testsuite/wanted-results/parallel-local-ssh4 | 21 +- testsuite/wanted-results/parallel-local22 | 2 - 7 files changed, 99 insertions(+), 149 deletions(-) diff --git a/src/parallel b/src/parallel index d2754200..a6fc1dc1 100755 --- a/src/parallel +++ b/src/parallel @@ -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-&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", "<{'exitstatus'} - and not ($self->virgin() and $opt::pipe)) { + and not ($self->virgin() and $opt::pipe)) { # Add to joblog when finished $self->print_joblog(); } diff --git a/testsuite/Start.sh b/testsuite/Start.sh index b6bc3097..419185db 100644 --- a/testsuite/Start.sh +++ b/testsuite/Start.sh @@ -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}" | diff --git a/testsuite/tests-to-run/parallel-local-ssh4.sh b/testsuite/tests-to-run/parallel-local-ssh4.sh index 5bc4abcf..cff2bac8 100644 --- a/testsuite/tests-to-run/parallel-local-ssh4.sh +++ b/testsuite/tests-to-run/parallel-local-ssh4.sh @@ -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' diff --git a/testsuite/tests-to-run/parallel-tutorial.sh b/testsuite/tests-to-run/parallel-tutorial.sh index a2ff0992..b56c8f5c 100644 --- a/testsuite/tests-to-run/parallel-tutorial.sh +++ b/testsuite/tests-to-run/parallel-tutorial.sh @@ -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:; diff --git a/testsuite/wanted-results/parallel-local-0.3s b/testsuite/wanted-results/parallel-local-0.3s index 226d8758..b396e7de 100644 --- a/testsuite/wanted-results/parallel-local-0.3s +++ b/testsuite/wanted-results/parallel-local-0.3s @@ -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 diff --git a/testsuite/wanted-results/parallel-local-ssh4 b/testsuite/wanted-results/parallel-local-ssh4 index 8e167abf..49e162c3 100644 --- a/testsuite/wanted-results/parallel-local-ssh4 +++ b/testsuite/wanted-results/parallel-local-ssh4 @@ -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 diff --git a/testsuite/wanted-results/parallel-local22 b/testsuite/wanted-results/parallel-local22 index 449ac20b..58e88acf 100644 --- a/testsuite/wanted-results/parallel-local22 +++ b/testsuite/wanted-results/parallel-local22 @@ -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