| Subject: | Bug report ClearCase-Argv-1.48 |
| Date: | Tue, 4 May 2010 17:42:13 -0700 |
| To: | bug-Argv [...] rt.cpan.org |
| From: | cnacs cnacs <cnaccs [...] gmail.com> |
*
Bug report ClearCase-Argv-1.48
*
This is perl, v5.8.0 built for i386-linux-thread-multi
Linux lnxpeblade01 2.4.21-47.0.1.ELsmp #1 SMP Fri Oct 13 17:56:20 EDT 2006
i686 i686 i386 GNU/Linux
Problem is a parse error when an operand string matches an option string.
Script to demonstrate follows. The problem exists in factor(). factor()
teases apart the opts and the args. The problem comes when an args string
matches an opt string. factor() incorrectly removes both copies of the
string from opt and places them in args. I have a suggested fix below. It
still has potential problems if require_order is not in effect, but it is
better in that it won't move too many strings to args, and it is much better
in that it works for the stuff I need :-).
Sorry I couldn't figure out a good way to show diffs, so here is the entire
function
###############################################
# Suggested fix
###############################################
sub factor {
my $self = shift;
my($pset, $r_desc, $r_opts, $r_args, $r_cfg) = @_;
my @vgra;
{
local @ARGV = @$r_args;
if ($r_desc && @$r_desc) {
require Getopt::Long;
# Need this version so Configure() returns prev state.
Getopt::Long->VERSION(2.23);
if ($r_cfg && @$r_cfg) {
my $prev = Getopt::Long::Configure(@$r_cfg);
GetOptions($self->{AV_LKG}{$pset}, @$r_desc);
Getopt::Long::Configure($prev);
} else {
local $Getopt::Long::passthrough = 1;
local $Getopt::Long::autoabbrev = 1;
local $Getopt::Long::debug = 1 if $self->dbglevel == 5;
GetOptions($self->{AV_LKG}{$pset}, @$r_desc);
}
}
@vgra = @ARGV;
}
my(@opts, @args);
for (reverse @$r_args) {
if (@vgra && $vgra[$#vgra] eq $_) {
unshift(@args, pop (@vgra));
} else {
unshift(@opts, $_);
}
}
@$r_opts = @opts if $r_opts;
@$r_args = @args;
return @opts;
}
###############################################
# test script
###############################################
require Argv;
my $find = Argv->new(qw/prog -opt1 string1 -opt2 string2 string1/);
$find->dbglevel(5);
my @args = $find->args();
print "\start:'@args'\n\n";
# run the parse
$find->parse(qw( option1|opt1=s option2|opt2=s ));
@args = $find->args();
print "\nargs:'@args'\n";
my @opts = $find->opts();
print "opts:'@opts'\n";
$find->objdump;
exit;
__END__
###############################################
# First run against original code
Show quoted text
> perl bugtest.pl
start:'-opt1 string1 -opt2 string2 string1'
GetOpt::Long 2.32 ($Revision: 2.58 $) called from package "Argv".
ARGV: (-opt1 string1 -opt2 string2 string1)
autoabbrev=1,bundling=0,getopt_compat=1,gnu_compat=0,order=1,
ignorecase=1,passthrough=1,genprefix="(--|-|\+)".
=> user linkage: HASH(0xa0d3f78)
=> $opctl{opt1} = ARRAY(0xa16b9b4) ["s","option1",O,$,"<undef>"]
$opctl{option1} = ARRAY(0xa16b9b4) ["s","option1",O,$,"<undef>"]
$opctl{option2} = ARRAY(0xa0ce16c) ["s","option2",O,$,"<undef>"]
$opctl{opt2} = ARRAY(0xa0ce16c) ["s","option2",O,$,"<undef>"]
=> arg "-opt1"
=> find "-opt1"
=> split "-"+"opt1"
=> 1 hits (opt1) with "opt1" out of 4
=> found ["s","option1",O,$,"<undef>"] for "opt1"
=> cname for "opt1" is "option1"
=>$L{option1} = "string1"
=> arg "-opt2"
=> find "-opt2"
=> split "-"+"opt2"
=> 1 hits (opt2) with "opt2" out of 4
=> found ["s","option2",O,$,"<undef>"] for "opt2"
=> cname for "opt2" is "option2"
=>$L{option2} = "string2"
=> arg "string1"
=> find "string1"
=> saving "string1" (not an option, may permute)
=> restoring "string1"
args:'string1 string1'
opts:'-opt1 -opt2 string2'
$argv = bless( {
'PIPECB' => sub { "DUMMY" },
'CFG' => {},
'DBGLEVEL' => 5,
'AV_OPTS' => {
'' => [
'-opt1',
'-opt2',
'string2'
]
},
'AV_ARGS' => [
'string1',
'string1'
],
'AV_PROG' => [
'cleartool',
'prog'
],
'AV_DESC' => {
'' => [
'option1|opt1=s',
'option2|opt2=s'
]
},
'AV_LKG' => {
'' => {
'option1' => 'string1',
'option2' => 'string2'
}
}
}, 'ClearCase::Argv' );
###############################################
# Second run against original code
Show quoted text> perl bugtest.pl
start:'-opt1 string1 -opt2 string2 string1'
GetOpt::Long 2.32 ($Revision: 2.58 $) called from package "Argv".
ARGV: (-opt1 string1 -opt2 string2 string1)
autoabbrev=1,bundling=0,getopt_compat=1,gnu_compat=0,order=1,
ignorecase=1,passthrough=1,genprefix="(--|-|\+)".
=> user linkage: HASH(0x836fc88)
=> $opctl{opt1} = ARRAY(0x84076ac) ["s","option1",O,$,"<undef>"]
$opctl{option1} = ARRAY(0x84076ac) ["s","option1",O,$,"<undef>"]
$opctl{option2} = ARRAY(0x8369ddc) ["s","option2",O,$,"<undef>"]
$opctl{opt2} = ARRAY(0x8369ddc) ["s","option2",O,$,"<undef>"]
=> arg "-opt1"
=> find "-opt1"
=> split "-"+"opt1"
=> 1 hits (opt1) with "opt1" out of 4
=> found ["s","option1",O,$,"<undef>"] for "opt1"
=> cname for "opt1" is "option1"
=>$L{option1} = "string1"
=> arg "-opt2"
=> find "-opt2"
=> split "-"+"opt2"
=> 1 hits (opt2) with "opt2" out of 4
=> found ["s","option2",O,$,"<undef>"] for "opt2"
=> cname for "opt2" is "option2"
=>$L{option2} = "string2"
=> arg "string1"
=> find "string1"
=> saving "string1" (not an option, may permute)
=> restoring "string1"
args:'string1'
opts:'-opt1 string1 -opt2 string2'
$argv = bless( {
'PIPECB' => sub { "DUMMY" },
'CFG' => {},
'DBGLEVEL' => 5,
'AV_OPTS' => {
'' => [
'-opt1',
'string1',
'-opt2',
'string2'
]
},
'AV_ARGS' => [
'string1'
],
'AV_PROG' => [
'cleartool',
'prog'
],
'AV_DESC' => {
'' => [
'option1|opt1=s',
'option2|opt2=s'
]
},
'AV_LKG' => {
'' => {
'option1' => 'string1',
'option2' => 'string2'
}
}
}, 'ClearCase::Argv' );
Message body is not shown because it is too large.