From 51f9bb2329dc9a35c0b11e0c329549d8cd4cfca7 Mon Sep 17 00:00:00 2001 From: Ole Tange Date: Mon, 11 Jul 2022 01:27:35 +0800 Subject: [PATCH] parallel: --colour-failed implemented. --- src/parallel | 210 ++++++++++-------- src/parallel.pod | 20 +- testsuite/REQUIREMENTS | 2 +- testsuite/tests-to-run/parallel-local-0.3s.sh | 16 ++ .../tests-to-run/parallel-local-parsort.sh | 2 +- testsuite/wanted-results/parallel-local-0.3s | 46 +++- 6 files changed, 200 insertions(+), 96 deletions(-) diff --git a/src/parallel b/src/parallel index f72360ea..79523bd5 100755 --- a/src/parallel +++ b/src/parallel @@ -1822,8 +1822,12 @@ sub options_completion_hash() { ("tag-string|tagstring=s". "[Tag lines with a string]:str" => \$opt::tagstring), "ctag[Color tag]:str" => \$opt::ctag, - "ctag-string|ctagstring=s[Color tagstring]:str" => \$opt::ctagstring, - "color|colour[Colorize output]" => \$opt::color, + "ctag-string|ctagstring=s[Colour tagstring]:str" => \$opt::ctagstring, + "color|colour[Colourize output]" => \$opt::color, + ("color-failed|colour-failed|colorfailed|colourfailed|". + "color-fail|colour-fail|colorfail|colourfail|cf". + "[Colour failed jobs red]" + => \$opt::colorfailed), ("onall[Run all the jobs on all computers given with --sshlogin]" => \$opt::onall), "nonall[--onall with no arguments]" => \$opt::nonall, @@ -11133,8 +11137,18 @@ sub print_files($) { } } + +# Different print types +# (--ll | --ll --bar | --lb | --group | --parset | --sql-worker) +# (--files | --results (.json|.csv|.tsv) ) +# --color-failed +# --color +# --keep-order +# --tag +# --bar + { - my ($up,$eol,$reset_color,$init,$curseq,$maxseq); + my ($up,$init,$curseq,$maxseq); sub print_linebuffer($) { sub print_llb($) { @@ -11142,12 +11156,13 @@ sub print_files($) { my $out_fh = shift; my $str = shift; my $seq = $self->seq(); + my ($color,$reset_color) = $self->color(); $maxseq = $seq > $maxseq ? $seq : $maxseq; print($out_fh "$up"x($curseq - $seq), "\n"x($seq - $curseq), "\r", $self->tag(), - $str, $eol, $reset_color, + $color,$str,$reset_color, "\n"x($maxseq-$seq+1)); $curseq = $maxseq + 1; } @@ -11169,16 +11184,10 @@ sub print_files($) { } if(not $init) { $init = 1; - if($Global::color or $opt::latestline) { + if($opt::latestline) { # cursor_up cuu1 = up one line $up = `tput cuu1 tag(); - $print =~ s/([\n\r])(?=.|$)/$eol$reset_color$1$tag/gs; - print $out_fh $tag, $print, $eol, - $reset_color, "\n"; + my ($color,$reset_color) = $self->color(); + my $colortag = $color.$self->tag(); + # \n => reset \n color tag + $print =~ s{([\n\r])(?=.|$)} + {$reset_color$1$colortag}gs; + print($out_fh $colortag, $print, + $reset_color, "\n"); } elsif($opt::tag or defined $opt::tagstring) { # Replace ^ with $tag within the full line if($Global::cache_replacement_eval) { @@ -11403,21 +11415,35 @@ sub print_normal($) { if($Global::parset and $fdno == 1) { $outputlength += $self->print_parset($fdno,$in_fh,$out_fh); } elsif(defined $opt::tag or defined $opt::tagstring - or $Global::color) { - # Read line by line - local $/ = "\n"; - my $tag = $self->tag(); - while(<$in_fh>) { - $outputlength += length $_; - # Tag lines with \r, too - $_ =~ s/(?<=[\r])(?=.|$)/$tag/gs; - if($Global::color) { - print_color($out_fh,$tag,$_); - } else { - print $out_fh $tag,$_; + or $Global::color or $opt::colorfailed) { + if($Global::color or $opt::colorfailed) { + my ($color,$reset_color) = $self->color(); + my $colortag = $color.$self->tag(); + # Read line by line + local $/ = "\n"; + while(<$in_fh>) { + $outputlength += length $_; + # Tag lines with \r, too + chomp; + s{([\n\r])(?=.|$)}{$reset_color$1$colortag}gs; + print $out_fh $colortag,$_,$reset_color,"\n"; } - if($Global::membuffer) { - push @{$self->{'output'}{$fdno}}, $tag, $_; + } else { + my $tag = $self->tag(); + my $pretag = 1; + my $s; + while(sysread($in_fh,$buf,32767)) { + $outputlength += length $buf; + $buf =~ s/(?<=[\r\n])(?=.)/$tag/gs; + print $out_fh ($pretag ? $tag : ""),$buf; + if($Global::membuffer) { + push @{$self->{'output'}{$fdno}}, + ($pretag ? $tag : ""),$buf; + } + # Should next print start with a tag? + $s = substr($buf, -1); + # This is faster than ($s eq "\n") || ($s eq "\r") + $pretag = ($s eq "\n") ? 1 : ($s eq "\r"); } } } else { @@ -11516,75 +11542,81 @@ sub print_joblog($) { $self->set_job_in_joblog(); } +sub tag($) { + my $self = shift; + if(not defined $self->{'tag'} or not $Global::cache_replacement_eval) { + if(defined $opt::tag or defined $opt::tagstring) { + $self->{'tag'} = + ($self->{'commandline'}-> + replace_placeholders([$opt::tagstring],0,0)). + "\t"; + } else { + # No tag + $self->{'tag'} = ""; + } + } + return $self->{'tag'}; +} + { - my @color; - my $color_on = ""; - my ($up,$eol,$reset_color,$init,$curseq,$maxseq); + my (@color,$eol,$reset_color,$init); sub init_color() { - $init = 1; - # color combinations that are readable: black/white text - # on colored background, but not white on yellow - my @color_combinations = - # Force each color code to have the same length in chars - # This will make \t work as expected - ((map { [sprintf("%03d",$_),"000"] } - 6..7,9..11,13..15,40..51,75..87,113..123,147..159, - 171..182,185..231,249..254), - (map { [sprintf("%03d",$_),231] } - 1..9,12..13,16..45,52..81,88..114,124..149, - 160..178,180,182..184,196..214,232..250)); - # reorder list so adjacent colors are dissimilar - # %23 and %7 were found experimentally - @color_combinations = @color_combinations[ - sort { ($a%23 <=> $b%23) or ($b%7 <=> $a%7) } - 0..$#color_combinations - ]; - @color = map { - # TODO Can this be done with `tput` codes? - "\033[48;5;".$_->[0].";38;5;".$_->[1]."m" - } @color_combinations; + if(not $init) { + $init = 1; + # color combinations that are readable: black/white text + # on colored background, but not white on yellow + my @color_combinations = + # Force each color code to have the same length in chars + # This will make \t work as expected + ((map { [sprintf("%03d",$_),"000"] } + 6..7,9..11,13..15,40..51,75..87,113..123,147..159, + 171..182,185..231,249..254), + (map { [sprintf("%03d",$_),231] } + 1..9,12..13,16..45,52..81,88..114,124..149, + 160..178,180,182..184,196..214,232..250)); + # reorder list so adjacent colors are dissimilar + # %23 and %7 were found experimentally + @color_combinations = @color_combinations[ + sort { ($a%23 <=> $b%23) or ($b%7 <=> $a%7) } + 0..$#color_combinations + ]; + @color = map { + # TODO Can this be done with `tput` codes? + "\033[48;5;".$_->[0].";38;5;".$_->[1]."m" + } @color_combinations; - # cursor_up cuu1 = up one line - $up = `tput cuu1 {'tag'} or not $Global::cache_replacement_eval) { - if($Global::color) { - if(not $init) { init_color() } - # Choose a value based on the seq - $color_on = $color[$self->seq() % ($#color+1)].$eol; - } - if(defined $opt::tag or defined $opt::tagstring) { - $self->{'tag'} = - $color_on . - ($self->{'commandline'}-> - replace_placeholders([$opt::tagstring],0,0)). - "\t"; + if(not defined $self->{'color'}) { + if($Global::color or $opt::colorfailed) { + init_color(); + if($Global::color) { + # Choose a value based on the seq + $self->{'color'} = $color[$self->seq() % ($#color+1)].$eol; + } + if($opt::colorfailed) { + if($self->exitstatus()) { + # White on Red + # Can this be done more generally? + $self->{'color'} = "\033[48;5;"."196". + ";38;5;"."231"."m".$eol; + } + } } else { - $self->{'tag'} = $color_on; + $self->{'color'} = ""; } } - return $self->{'tag'}; + return ($self->{'color'},$reset_color); } } diff --git a/src/parallel.pod b/src/parallel.pod index 6773dca6..3fcb59d7 100644 --- a/src/parallel.pod +++ b/src/parallel.pod @@ -748,7 +748,8 @@ B<--transfer>, B<--transferfile> or B<--return>. See also: B<--basefile> B<--transfer> B<--transferfile> B<--sshlogin> B<--return> -=item B<--color> (beta testing) + +=item B<--color> (alpha testing) Colour output. @@ -757,6 +758,23 @@ Colour the output. Each job gets its own colour combination B<--color> is ignored when using B<-u>. +See also: B<--color-failed> + + +=item B<--color-failed> (alpha testing) + +=item B<--cf> (alpha testing) + +Colour the output from failing jobs white on red. + +Useful if you have a lot of jobs and want to focus on the failing +jobs. + +B<--color-failed> is ignored when using B<-u>, B<--line-buffer> and +unreliable when using B<--latest-line>. + +See also: B<--color> + =item B<--colsep> I diff --git a/testsuite/REQUIREMENTS b/testsuite/REQUIREMENTS index d0bae1d3..957622d7 100644 --- a/testsuite/REQUIREMENTS +++ b/testsuite/REQUIREMENTS @@ -38,7 +38,7 @@ install_packages() { shell_pkgs="$shell_pkgs tcsh yash zsh busybox-static" # Databases - database_pkgs="postgresql mysql-server sqlite" + database_pkgs="postgresql mysql-server sqlite influxdb influxdb-client" # Build Tools build_pkgs="bison libxxhash-dev libzstd-dev liblz4-dev libssl-dev" diff --git a/testsuite/tests-to-run/parallel-local-0.3s.sh b/testsuite/tests-to-run/parallel-local-0.3s.sh index b332491e..fb7fbec2 100644 --- a/testsuite/tests-to-run/parallel-local-0.3s.sh +++ b/testsuite/tests-to-run/parallel-local-0.3s.sh @@ -16,6 +16,22 @@ export -f stdsort # Test amount of parallelization # parallel --shuf --jl /tmp/myjl -j1 'export JOBS={1};'bash tests-to-run/parallel-local-0.3s.sh ::: {1..16} ::: {1..5} +par_PARALLEL_HOME_not_exist() { + echo '### bug #62311: --pipepart + ::: fail' + tmp1=$(mktemp) + rm $tmp1 + PARALLEL_HOME=$tmp1 parallel echo ::: OK + rm -r $tmp1 + echo Should warn: + PARALLEL_HOME=/does-not-exist parallel -k echo ::: should warn +} + +par_colour_failed() { + echo '--colour-failed --colour' + parallel --colour-failed -kv 'seq {1};exit {2}' ::: 1 2 ::: 0 1 2 + parallel --colour --colour-failed -kv 'seq {1};exit {2}' ::: 1 2 ::: 0 1 2 +} + par_pipepart_triple_colon() { echo '### bug #62311: --pipepart + ::: fail' tmp1=$(mktemp) diff --git a/testsuite/tests-to-run/parallel-local-parsort.sh b/testsuite/tests-to-run/parallel-local-parsort.sh index 7a9f5d72..7bd809a8 100755 --- a/testsuite/tests-to-run/parallel-local-parsort.sh +++ b/testsuite/tests-to-run/parallel-local-parsort.sh @@ -5,7 +5,7 @@ # SPDX-License-Identifier: GPL-3.0-or-later setup() { - tmp=$(tempfile) + tmp=$(mktemp) perl -pe 's/\n/\n\0/' >$tmp <