Skip Menu |
 

This queue is for tickets about the Argv CPAN distribution.

Report information
The Basics
Id: 57216
Status: new
Priority: 0/
Queue: Argv

People
Owner: Nobody in particular
Requestors: cnaccs [...] gmail.com
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)



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>
Download (untitled) / with headers
text/plain 7.3k
* 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' );
Download (untitled) / with headers
text/html 13.5k

Message body is not shown because it is too large.



This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.