mirror of
https://git.savannah.gnu.org/git/parallel.git
synced 2024-11-26 16:07:54 +00:00
Fixed bug #44144: --tagstring {=s/a/b/=} broken and bug #44044: --return with {= perl expr =} does not work.
This commit is contained in:
parent
cb23a23da1
commit
6edfaf29ea
69
src/parallel
69
src/parallel
|
@ -288,7 +288,7 @@ sub spreadstdin {
|
||||||
# Uses:
|
# Uses:
|
||||||
# $opt::blocksize
|
# $opt::blocksize
|
||||||
# STDIN
|
# STDIN
|
||||||
# $opr::r
|
# $opt::r
|
||||||
# $Global::max_lines
|
# $Global::max_lines
|
||||||
# $Global::max_number_of_args
|
# $Global::max_number_of_args
|
||||||
# $opt::regexp
|
# $opt::regexp
|
||||||
|
@ -901,7 +901,8 @@ sub parse_options {
|
||||||
$Global::ContextReplace = 1;
|
$Global::ContextReplace = 1;
|
||||||
}
|
}
|
||||||
if(defined $opt::tag and not defined $opt::tagstring) {
|
if(defined $opt::tag and not defined $opt::tagstring) {
|
||||||
$opt::tagstring = "\257<\257>"; # Default = {}
|
# Default = {}
|
||||||
|
$opt::tagstring = $Global::parensleft.$Global::parensright;
|
||||||
}
|
}
|
||||||
if(defined $opt::pipepart and
|
if(defined $opt::pipepart and
|
||||||
(defined $opt::L or defined $opt::max_lines
|
(defined $opt::L or defined $opt::max_lines
|
||||||
|
@ -953,7 +954,7 @@ sub parse_options {
|
||||||
|
|
||||||
sub init_globals {
|
sub init_globals {
|
||||||
# Defaults:
|
# Defaults:
|
||||||
$Global::version = 20150122;
|
$Global::version = 20150123;
|
||||||
$Global::progname = 'parallel';
|
$Global::progname = 'parallel';
|
||||||
$Global::infinity = 2**31;
|
$Global::infinity = 2**31;
|
||||||
$Global::debug = 0;
|
$Global::debug = 0;
|
||||||
|
@ -7442,6 +7443,7 @@ sub new {
|
||||||
my ($count,$posrpl,$perlexpr);
|
my ($count,$posrpl,$perlexpr);
|
||||||
my ($replacecount_ref, $len_ref);
|
my ($replacecount_ref, $len_ref);
|
||||||
my @command = @$commandref;
|
my @command = @$commandref;
|
||||||
|
my $dummy = '';
|
||||||
# If the first command start with '-' it is probably an option
|
# If the first command start with '-' it is probably an option
|
||||||
if($command[0] =~ /^\s*(-\S+)/) {
|
if($command[0] =~ /^\s*(-\S+)/) {
|
||||||
# Is this really a command in $PATH starting with '-'?
|
# Is this really a command in $PATH starting with '-'?
|
||||||
|
@ -7456,47 +7458,39 @@ sub new {
|
||||||
|
|
||||||
# Protect matching inside {= perl expr =}
|
# Protect matching inside {= perl expr =}
|
||||||
# by replacing {= and =} with \257< and \257>
|
# by replacing {= and =} with \257< and \257>
|
||||||
for(@command) {
|
# in @command, --return and --tagstring (if used)
|
||||||
|
for(@command,@$return_files,
|
||||||
|
(defined $opt::tagstring ? $opt::tagstring : $dummy)) {
|
||||||
|
# Disallow \257 to avoid nested {= {= =} =}
|
||||||
if(/\257/) {
|
if(/\257/) {
|
||||||
::error("Command cannot contain the character \257. Use a function for that.\n");
|
::error("Command cannot contain the character \257. Use a function for that.\n");
|
||||||
::wait_and_exit(255);
|
::wait_and_exit(255);
|
||||||
}
|
}
|
||||||
# Needs to match rightmost left parens (Perl defaults to leftmost)
|
# Needs to match rightmost left parens (Perl defaults to leftmost)
|
||||||
# to deal with: {={==}
|
# to deal with: {={==}
|
||||||
# Disallow \257 to avoid nested {= {= =} =}
|
while(s{([^\257]*) \Q$Global::parensleft\E ([^\257]*?) \Q$Global::parensright\E }
|
||||||
while(s/([^\257]*) \Q$Global::parensleft\E ([^\257]*?) \Q$Global::parensright\E /$1\257<$2\257>/gx) {}
|
{$1\257<$2\257>}gx) {}
|
||||||
}
|
for my $rpl (keys %Global::rpl) {
|
||||||
for my $rpl (keys %Global::rpl) {
|
# Replace the short hand string (--rpl)
|
||||||
# Replace the short hand string (--rpl)
|
# with the {= perl expr =}
|
||||||
# with the {= perl expr =} in $command and $opt::tagstring
|
# Avoid replacing inside existing {= perl expr =}
|
||||||
# Avoid replacing inside existing {= perl expr =}
|
while(s{((^|\257>)[^\257]*?) # Don't replace after \257 unless \257>
|
||||||
for(@command,@Global::ret_files) {
|
\Q$rpl\E}
|
||||||
while(s/((^|\257>)[^\257]*?) # Don't replace after \257 unless \257>
|
{$1\257<$Global::rpl{$rpl}\257>}xg) {
|
||||||
\Q$rpl\E/$1\257<$Global::rpl{$rpl}\257>/xg) {
|
|
||||||
}
|
}
|
||||||
}
|
# Do the same for the positional replacement strings
|
||||||
if(defined $opt::tagstring) {
|
# A bit harder as we have to put in the position number
|
||||||
for($opt::tagstring) {
|
$posrpl = $rpl;
|
||||||
while(s/((^|\257>)[^\257]*?) # Don't replace after \257 unless \257>
|
if($posrpl =~ s/^\{//) {
|
||||||
\Q$rpl\E/$1\257<$Global::rpl{$rpl}\257>/x) {}
|
# Only do this if the shorthand start with {
|
||||||
}
|
s{\{(-?\d+)\Q$posrpl\E}
|
||||||
}
|
{\257<$1 $Global::rpl{$rpl}\257>}g;
|
||||||
# Do the same for the positional replacement strings
|
|
||||||
# A bit harder as we have to put in the position number
|
|
||||||
$posrpl = $rpl;
|
|
||||||
if($posrpl =~ s/^\{//) {
|
|
||||||
# Only do this if the shorthand start with {
|
|
||||||
for(@command,@Global::ret_files) {
|
|
||||||
s/\{(-?\d+)\Q$posrpl\E/\257<$1 $Global::rpl{$rpl}\257>/g;
|
|
||||||
}
|
|
||||||
if(defined $opt::tagstring) {
|
|
||||||
$opt::tagstring =~ s/\{(-?\d+)\Q$posrpl\E/\257<$1 $perlexpr\257>/g;
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
# Add {} if no replacement strings in @command
|
# Add {} if no replacement strings in @command
|
||||||
($replacecount_ref, $len_ref, @command) =
|
($replacecount_ref, $len_ref, @command) =
|
||||||
replacement_counts_and_lengths(@command);
|
replacement_counts_and_lengths($return_files,@command);
|
||||||
if("@command" =~ /^[^ \t\n=]*\257</) {
|
if("@command" =~ /^[^ \t\n=]*\257</) {
|
||||||
# Replacement string is (part of) the command (and not just
|
# Replacement string is (part of) the command (and not just
|
||||||
# argument or variable definition V1={})
|
# argument or variable definition V1={})
|
||||||
|
@ -7561,9 +7555,11 @@ sub replacement_counts_and_lengths {
|
||||||
# If no {} found in @command: add it to @command
|
# If no {} found in @command: add it to @command
|
||||||
#
|
#
|
||||||
# Input:
|
# Input:
|
||||||
|
# \@return_files = array of filenames to return
|
||||||
# @command = command template
|
# @command = command template
|
||||||
# Output:
|
# Output:
|
||||||
# \%replacecount, \%len, @command
|
# \%replacecount, \%len, @command
|
||||||
|
my $return_files = shift;
|
||||||
my @command = @_;
|
my @command = @_;
|
||||||
my (%replacecount,%len);
|
my (%replacecount,%len);
|
||||||
my $sum = 0;
|
my $sum = 0;
|
||||||
|
@ -7592,6 +7588,15 @@ sub replacement_counts_and_lengths {
|
||||||
# All {= perl expr =} have been removed: The rest is non-context
|
# All {= perl expr =} have been removed: The rest is non-context
|
||||||
$noncontextlen += length $c;
|
$noncontextlen += length $c;
|
||||||
}
|
}
|
||||||
|
for(@$return_files) {
|
||||||
|
my $t = $_;
|
||||||
|
while($t =~ s/ \257<([^\257]*)\257> //x) {
|
||||||
|
# %replacecount = { "perlexpr" => number of times seen }
|
||||||
|
# e.g { "$_++" => 2 }
|
||||||
|
# But for tagstring we just need to mark it as seen
|
||||||
|
$replacecount{$1} ||= 1;
|
||||||
|
}
|
||||||
|
}
|
||||||
if($opt::tagstring) {
|
if($opt::tagstring) {
|
||||||
my $t = $opt::tagstring;
|
my $t = $opt::tagstring;
|
||||||
while($t =~ s/ \257<([^\257]*)\257> //x) {
|
while($t =~ s/ \257<([^\257]*)\257> //x) {
|
||||||
|
|
Loading…
Reference in a new issue