Upgrade to Getopt::Long 2.36

p4raw-id: //depot/perl@30086

7 files changed, 343 insertions, 71 deletions

diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm
index 4c2253a9f3..77a86add3c 100644
--- a/lib/Getopt/Long.pm
+++ b/lib/Getopt/Long.pm
@@ -2,17 +2,17 @@
 
 package Getopt::Long;
 
-# RCS Status      : $Id: GetoptLong.pm,v 2.72 2005-04-28 21:18:33+02 jv Exp $
+# RCS Status      : $Id: Long.pm,v 2.73 2007/01/27 20:00:34 jv Exp $
 # Author          : Johan Vromans
 # Created On      : Tue Sep 11 15:00:12 1990
 # Last Modified By: Johan Vromans
-# Last Modified On: Wed Dec 14 21:17:21 2005
-# Update Count    : 1458
+# Last Modified On: Sat Jan 27 20:59:00 2007
+# Update Count    : 1552
 # Status          : Released
 
 ################ Copyright ################
 
-# This program is Copyright 1990,2005 by Johan Vromans.
+# This program is Copyright 1990,2007 by Johan Vromans.
 # This program is free software; you can redistribute it and/or
 # modify it under the terms of the Perl Artistic License or the
 # GNU General Public License as published by the Free Software
@@ -35,10 +35,10 @@ use 5.004;
 use strict;
 
 use vars qw($VERSION);
-$VERSION        =  2.35_01;
+$VERSION        =  2.36;
 # For testing versions only.
-#use vars qw($VERSION_STRING);
-#$VERSION_STRING = "2.35";
+use vars qw($VERSION_STRING);
+$VERSION_STRING = "2.36";
 
 use Exporter;
 use vars qw(@ISA @EXPORT @EXPORT_OK);
@@ -46,6 +46,8 @@ use vars qw(@ISA @EXPORT @EXPORT_OK);
 
 # Exported subroutines.
 sub GetOptions(@);		# always
+sub GetOptionsFromArray($@);	# on demand
+sub GetOptionsFromString($@);	# on demand
 sub Configure(@);		# on demand
 sub HelpMessage(@);		# on demand
 sub VersionMessage(@);		# in demand
@@ -53,7 +55,8 @@ sub VersionMessage(@);		# in demand
 BEGIN {
     # Init immediately so their contents can be used in the 'use vars' below.
     @EXPORT    = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
-    @EXPORT_OK = qw(&HelpMessage &VersionMessage &Configure);
+    @EXPORT_OK = qw(&HelpMessage &VersionMessage &Configure
+		    &GetOptionsFromArray &GetOptionsFromString);
 }
 
 # User visible variables.
@@ -72,7 +75,7 @@ sub config(@);			# deprecated name
 sub ConfigDefaults();
 sub ParseOptionSpec($$);
 sub OptCtl($);
-sub FindOption($$$$);
+sub FindOption($$$$$);
 sub ValidValue ($$$$$);
 
 ################ Local Variables ################
@@ -247,9 +250,44 @@ use constant CTL_AMAX    => 5;
 #use constant CTL_RANGE   => ;
 #use constant CTL_REPEAT  => ;
 
+# Rather liberal patterns to match numbers.
+use constant PAT_INT   => "[-+]?_*[0-9][0-9_]*";
+use constant PAT_XINT  =>
+  "(?:".
+	  "[-+]?_*[1-9][0-9_]*".
+  "|".
+	  "0x_*[0-9a-f][0-9a-f_]*".
+  "|".
+	  "0b_*[01][01_]*".
+  "|".
+	  "0[0-7_]*".
+  ")";
+use constant PAT_FLOAT => "[-+]?[0-9._]+(\.[0-9_]+)?([eE][-+]?[0-9_]+)?";
+
 sub GetOptions(@) {
+    # Shift in default array.
+    unshift(@_, \@ARGV);
+    # Try to keep caller() and Carp consitent.
+    goto &GetOptionsFromArray;
+}
+
+sub GetOptionsFromString($@) {
+    my ($string) = shift;
+    require Text::ParseWords;
+    my $args = [ Text::ParseWords::shellwords($string) ];
+    $caller ||= (caller)[0];	# current context
+    my $ret = GetOptionsFromArray($args, @_);
+    return ( $ret, $args ) if wantarray;
+    if ( @$args ) {
+	$ret = 0;
+	warn("GetOptionsFromString: Excess data \"@$args\" in string \"$string\"\n");
+    }
+    $ret;
+}
 
-    my @optionlist = @_;	# local copy of the option descriptions
+sub GetOptionsFromArray($@) {
+
+    my ($argv, @optionlist) = @_;	# local copy of the option descriptions
     my $argend = '--';		# option list terminator
     my %opctl = ();		# table of option specs
     my $pkg = $caller || (caller)[0];	# current context
@@ -267,10 +305,10 @@ sub GetOptions(@) {
 	local ($^W) = 0;
 	print STDERR
 	  ("Getopt::Long $Getopt::Long::VERSION (",
-	   '$Revision: 2.72 $', ") ",
+	   '$Revision: 2.73 $', ") ",
 	   "called from package \"$pkg\".",
 	   "\n  ",
-	   "ARGV: (@ARGV)",
+	   "argv: (@$argv)",
 	   "\n  ",
 	   "autoabbrev=$autoabbrev,".
 	   "bundling=$bundling,",
@@ -383,7 +421,7 @@ sub GetOptions(@) {
 	    elsif ( $rl eq "HASH" ) {
 		$opctl{$name}[CTL_DEST] = CTL_DEST_HASH;
 	    }
-	    elsif ( $rl eq "SCALAR" ) {
+	    elsif ( $rl eq "SCALAR" || $rl eq "REF" ) {
 #		if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) {
 #		    my $t = $linkage{$orig};
 #		    $$t = $linkage{$orig} = [];
@@ -456,10 +494,10 @@ sub GetOptions(@) {
 
     # Process argument list
     my $goon = 1;
-    while ( $goon && @ARGV > 0 ) {
+    while ( $goon && @$argv > 0 ) {
 
 	# Get next argument.
-	$opt = shift (@ARGV);
+	$opt = shift (@$argv);
 	print STDERR ("=> arg \"", $opt, "\"\n") if $debug;
 
 	# Double dash is option list terminator.
@@ -476,7 +514,7 @@ sub GetOptions(@) {
 	my $ctl;		# the opctl entry
 
 	($found, $opt, $ctl, $arg, $key) =
-	  FindOption ($prefix, $argend, $opt, \%opctl);
+	  FindOption ($argv, $prefix, $argend, $opt, \%opctl);
 
 	if ( $found ) {
 
@@ -495,7 +533,8 @@ sub GetOptions(@) {
 		    print STDERR ("=> ref(\$L{$opt}) -> ",
 				  ref($linkage{$opt}), "\n") if $debug;
 
-		    if ( ref($linkage{$opt}) eq 'SCALAR' ) {
+		    if ( ref($linkage{$opt}) eq 'SCALAR'
+			 || ref($linkage{$opt}) eq 'REF' ) {
 			if ( $ctl->[CTL_TYPE] eq '+' ) {
 			    print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")
 			      if $debug;
@@ -551,9 +590,16 @@ sub GetOptions(@) {
 			    local $@;
 			    local $SIG{__DIE__}  = '__DEFAULT__';
 			    eval {
-				&{$linkage{$opt}}($opt,
-						  $ctl->[CTL_DEST] == CTL_DEST_HASH ? ($key) : (),
-						  $arg);
+				&{$linkage{$opt}}
+				  (Getopt::Long::CallBack->new
+				   (name    => $opt,
+				    ctl     => $ctl,
+				    opctl   => \%opctl,
+				    linkage => \%linkage,
+				    prefix  => $prefix,
+				   ),
+				   $ctl->[CTL_DEST] == CTL_DEST_HASH ? ($key) : (),
+				   $arg);
 			    };
 			    $@;
 			};
@@ -623,14 +669,15 @@ sub GetOptions(@) {
 
 		# Need more args?
 		if ( $argcnt < $ctl->[CTL_AMIN] ) {
-		    if ( @ARGV ) {
-			if ( ValidValue($ctl, $ARGV[0], 1, $argend, $prefix) ) {
-			    $arg = shift(@ARGV);
+		    if ( @$argv ) {
+			if ( ValidValue($ctl, $argv->[0], 1, $argend, $prefix) ) {
+			    $arg = shift(@$argv);
+			    $arg =~ tr/_//d if $ctl->[CTL_TYPE] =~ /^[iIo]$/;
 			    ($key,$arg) = $arg =~ /^([^=]+)=(.*)/
 			      if $ctl->[CTL_DEST] == CTL_DEST_HASH;
 			    next;
 			}
-			warn("Value \"$ARGV[0]\" invalid for option $opt\n");
+			warn("Value \"$$argv[0]\" invalid for option $opt\n");
 			$error++;
 		    }
 		    else {
@@ -640,8 +687,9 @@ sub GetOptions(@) {
 		}
 
 		# Any more args?
-		if ( @ARGV && ValidValue($ctl, $ARGV[0], 0, $argend, $prefix) ) {
-		    $arg = shift(@ARGV);
+		if ( @$argv && ValidValue($ctl, $argv->[0], 0, $argend, $prefix) ) {
+		    $arg = shift(@$argv);
+		    $arg =~ tr/_//d if $ctl->[CTL_TYPE] =~ /^[iIo]$/;
 		    ($key,$arg) = $arg =~ /^([^=]+)=(.*)/
 		      if $ctl->[CTL_DEST] == CTL_DEST_HASH;
 		    next;
@@ -685,7 +733,7 @@ sub GetOptions(@) {
 	# ...otherwise, terminate.
 	else {
 	    # Push this one back and exit.
-	    unshift (@ARGV, $tryopt);
+	    unshift (@$argv, $tryopt);
 	    return ($error == 0);
 	}
 
@@ -696,7 +744,7 @@ sub GetOptions(@) {
 	#  Push back accumulated arguments
 	print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
 	    if $debug;
-	unshift (@ARGV, @ret);
+	unshift (@$argv, @ret);
     }
 
     return ($error == 0);
@@ -842,13 +890,13 @@ sub ParseOptionSpec ($$) {
 }
 
 # Option lookup.
-sub FindOption ($$$$) {
+sub FindOption ($$$$$) {
 
     # returns (1, $opt, $ctl, $arg, $key) if okay,
     # returns (1, undef) if option in error,
     # returns (0) otherwise.
 
-    my ($prefix, $argend, $opt, $opctl) = @_;
+    my ($argv, $prefix, $argend, $opt, $opctl) = @_;
 
     print STDERR ("=> find \"$opt\"\n") if $debug;
 
@@ -966,7 +1014,7 @@ sub FindOption ($$$$) {
 	# Pretend one char when bundling.
 	if ( $bundling == 1 && length($starter) == 1 ) {
 	    $opt = substr($opt,0,1);
-            unshift (@ARGV, $starter.$rest) if defined $rest;
+            unshift (@$argv, $starter.$rest) if defined $rest;
 	}
 	warn ("Unknown option: ", $opt, "\n");
 	$error++;
@@ -998,7 +1046,7 @@ sub FindOption ($$$$) {
 	    $opt =~ s/^no-?//i;	# strip NO prefix
 	    $arg = 0;		# supply explicit value
 	}
-	unshift (@ARGV, $starter.$rest) if defined $rest;
+	unshift (@$argv, $starter.$rest) if defined $rest;
 	return (1, $opt, $ctl, $arg);
     }
 
@@ -1014,7 +1062,7 @@ sub FindOption ($$$$) {
     # Check if there is an option argument available.
     if ( defined $optarg
 	 ? ($optarg eq '')
-	 : !(defined $rest || @ARGV > 0) ) {
+	 : !(defined $rest || @$argv > 0) ) {
 	# Complain if this option needs an argument.
 	if ( $mand ) {
 	    return (0) if $passthrough;
@@ -1035,7 +1083,7 @@ sub FindOption ($$$$) {
 
     # Get (possibly optional) argument.
     $arg = (defined $rest ? $rest
-	    : (defined $optarg ? $optarg : shift (@ARGV)));
+	    : (defined $optarg ? $optarg : shift (@$argv)));
 
     # Get key if this is a "name=value" pair for a hash option.
     my $key;
@@ -1047,7 +1095,7 @@ sub FindOption ($$$$) {
 	    warn ("Option $opt, key \"$key\", requires a value\n");
 	    $error++;
 	    # Push back.
-	    unshift (@ARGV, $starter.$rest) if defined $rest;
+	    unshift (@$argv, $starter.$rest) if defined $rest;
 	    return (1, undef);
 	}
     }
@@ -1060,6 +1108,10 @@ sub FindOption ($$$$) {
 	# A mandatory string takes anything.
 	return (1, $opt, $ctl, $arg, $key) if $mand;
 
+	# Same for optional string as a hash value
+	return (1, $opt, $ctl, $arg, $key)
+	  if $ctl->[CTL_DEST] == CTL_DEST_HASH;
+
 	# An optional string takes almost anything.
 	return (1, $opt, $ctl, $arg, $key)
 	  if defined $optarg || defined $rest;
@@ -1069,7 +1121,7 @@ sub FindOption ($$$$) {
 	if ($arg eq $argend ||
 	    $arg =~ /^$prefix.+/) {
 	    # Push back.
-	    unshift (@ARGV, $arg);
+	    unshift (@$argv, $arg);
 	    # Supply empty value.
 	    $arg = '';
 	}
@@ -1079,24 +1131,23 @@ sub FindOption ($$$$) {
             || $type eq 'I'	# numeric/integer w/ incr default
 	    || $type eq 'o' ) { # dec/oct/hex/bin value
 
-	my $o_valid =
-	  $type eq 'o' ? "[-+]?[1-9][0-9]*|0x[0-9a-f]+|0b[01]+|0[0-7]*"
-	    : "[-+]?[0-9]+";
+	my $o_valid = $type eq 'o' ? PAT_XINT : PAT_INT;
 
 	if ( $bundling && defined $rest
 	     && $rest =~ /^($key_valid)($o_valid)(.*)$/si ) {
 	    ($key, $arg, $rest) = ($1, $2, $+);
 	    chop($key) if $key;
 	    $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
-	    unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
+	    unshift (@$argv, $starter.$rest) if defined $rest && $rest ne '';
 	}
-	elsif ( $arg =~ /^($o_valid)$/si ) {
+	elsif ( $arg =~ /^$o_valid$/si ) {
+	    $arg =~ tr/_//d;
 	    $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
 	}
 	else {
 	    if ( defined $optarg || $mand ) {
 		if ( $passthrough ) {
-		    unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
+		    unshift (@$argv, defined $rest ? $starter.$rest : $arg)
 		      unless defined $optarg;
 		    return (0);
 		}
@@ -1106,12 +1157,12 @@ sub FindOption ($$$$) {
 		      "number expected)\n");
 		$error++;
 		# Push back.
-		unshift (@ARGV, $starter.$rest) if defined $rest;
+		unshift (@$argv, $starter.$rest) if defined $rest;
 		return (1, undef);
 	    }
 	    else {
 		# Push back.
-		unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
+		unshift (@$argv, defined $rest ? $starter.$rest : $arg);
 		if ( $type eq 'I' ) {
 		    # Fake incremental type.
 		    my @c = @$ctl;
@@ -1128,16 +1179,21 @@ sub FindOption ($$$$) {
 	# We require at least one digit before a point or 'e',
 	# and at least one digit following the point and 'e'.
 	# [-]NN[.NN][eNN]
+	my $o_valid = PAT_FLOAT;
 	if ( $bundling && defined $rest &&
-	     $rest =~ /^($key_valid)([-+]?[0-9]+(\.[0-9]+)?([eE][-+]?[0-9]+)?)(.*)$/s ) {
+	     $rest =~ /^($key_valid)($o_valid)(.*)$/s ) {
+	    $arg =~ tr/_//d;
 	    ($key, $arg, $rest) = ($1, $2, $+);
 	    chop($key) if $key;
-	    unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
+	    unshift (@$argv, $starter.$rest) if defined $rest && $rest ne '';
 	}
-	elsif ( $arg !~ /^[-+]?[0-9.]+(\.[0-9]+)?([eE][-+]?[0-9]+)?$/ ) {
+	elsif ( $arg =~ /^$o_valid$/ ) {
+	    $arg =~ tr/_//d;
+	}
+	else {
 	    if ( defined $optarg || $mand ) {
 		if ( $passthrough ) {
-		    unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
+		    unshift (@$argv, defined $rest ? $starter.$rest : $arg)
 		      unless defined $optarg;
 		    return (0);
 		}
@@ -1145,12 +1201,12 @@ sub FindOption ($$$$) {
 		      $opt, " (real number expected)\n");
 		$error++;
 		# Push back.
-		unshift (@ARGV, $starter.$rest) if defined $rest;
+		unshift (@$argv, $starter.$rest) if defined $rest;
 		return (1, undef);
 	    }
 	    else {
 		# Push back.
-		unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
+		unshift (@$argv, defined $rest ? $starter.$rest : $arg);
 		# Supply default value.
 		$arg = 0.0;
 	    }
@@ -1187,10 +1243,7 @@ sub ValidValue ($$$$$) {
             || $type eq 'I'	# numeric/integer w/ incr default
 	    || $type eq 'o' ) { # dec/oct/hex/bin value
 
-	my $o_valid =
-	  $type eq 'o' ? "[-+]?[1-9][0-9]*|0x[0-9a-f]+|0b[01]+|0[0-7]*"
-	    : "[-+]?[0-9]+";
-
+	my $o_valid = $type eq 'o' ? PAT_XINT : PAT_INT;
 	return $arg =~ /^$o_valid$/si;
     }
 
@@ -1198,7 +1251,8 @@ sub ValidValue ($$$$$) {
 	# We require at least one digit before a point or 'e',
 	# and at least one digit following the point and 'e'.
 	# [-]NN[.NN][eNN]
-	return $arg =~ /^[-+]?[0-9.]+(\.[0-9]+)?([eE][-+]?[0-9]+)?$/;
+	my $o_valid = PAT_FLOAT;
+	return $arg =~ /^$o_valid$/;
     }
     die("ValidValue: Cannot happen\n");
 }
@@ -1264,7 +1318,7 @@ sub Configure (@) {
 	elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
 	    $ignorecase = $action;
 	}
-	elsif ( $try eq 'ignore_case_always' ) {
+	elsif ( $try eq 'ignorecase_always' or $try eq 'ignore_case_always' ) {
 	    $ignorecase = $action ? 2 : 0;
 	}
 	elsif ( $try eq 'bundling' ) {
@@ -1413,6 +1467,24 @@ sub VERSION {
     shift->SUPER::VERSION(@_);
 }
 
+package Getopt::Long::CallBack;
+
+sub new {
+    my ($pkg, %atts) = @_;
+    bless { %atts }, $pkg;
+}
+
+sub name {
+    my $self = shift;
+    ''.$self->{name};
+}
+
+use overload
+  # Treat this object as an oridinary string for legacy API.
+  '""'	   => \&name,
+  '0+'	   => sub { 0 },
+  fallback => 1;
+
 1;
 
 ################ Documentation ################
@@ -1921,11 +1993,51 @@ messages. For example:
 
 See L<Pod::Usage> for details.
 
-=head2 Storing option values in a hash
+=head2 Parsing options from an arbitrary array
+
+By default, GetOptions parses the options that are present in the
+global array C<@ARGV>. A special entry C<GetOptionsFromArray> can be
+used to parse options from an arbitrary array.
+
+    use Getopt::Long qw(GetOptionsFromArray);
+    $ret = GetOptionsFromArray(\@myopts, ...);
+
+When used like this, the global C<@ARGV> is not touched at all.
+
+The following two calls behave identically:
+
+    $ret = GetOptions( ... );
+    $ret = GetOptionsFromArray(\@ARGV, ... );
+
+=head2 Parsing options from an arbitrary string
+
+A special entry C<GetOptionsFromString> can be used to parse options
+from an arbitrary string.
+
+    use Getopt::Long qw(GetOptionsFromString);
+    $ret = GetOptionsFromString($string, ...);
+
+The contents of the string are split into arguments using a call to
+C<Text::ParseWords::shellwords>. As with C<GetOptionsFromArray>, the
+global C<@ARGV> is not touched.
+
+It is possible that, upon completion, not all arguments in the string
+have been processed. C<GetOptionsFromString> will, when called in list
+context, return both the return status and an array reference to any
+remaining arguments:
+
+    ($ret, $args) = GetOptionsFromString($string, ... );
+
+If any arguments remain, and C<GetOptionsFromString> was not called in
+list context, a message will be given and C<GetOptionsFromString> will
+return failure.
+
+=head2 Storing options values in a hash
 
 Sometimes, for example when there are a lot of options, having a
 separate variable for each of them can be cumbersome. GetOptions()
-supports, as an alternative mechanism, storing options in a hash.
+supports, as an alternative mechanism, storing options values in a
+hash.
 
 To obtain this, a reference to a hash must be passed I<as the first
 argument> to GetOptions(). For each option that is specified on the
@@ -2435,6 +2547,25 @@ configuring. Although manipulating these variables still work, it is
 strongly encouraged to use the C<Configure> routine that was introduced
 in version 2.17. Besides, it is much easier.
 
+=head1 Tips and Techniques
+
+=head2 Pushing multiple values in a hash option
+
+Sometimes you want to combine the best of hashes and arrays. For
+example, the command line:
+
+  --list add=first --list add=second --list add=third
+
+where each successive 'list add' option will push the value of add
+into array ref $list->{'add'}. The result would be like
+
+  $list->{add} = [qw(first second third)];
+
+This can be accomplished with a destination routine:
+
+  GetOptions('list=s%' =>
+               sub { push(@{$list{$_[1]}}, $_[2]) });
+
 =head1 Trouble Shooting
 
 =head2 GetOptions does not return a false result when an option is not supplied
@@ -2486,7 +2617,7 @@ Johan Vromans <jvromans@squirrel.nl>
 
 =head1 COPYRIGHT AND DISCLAIMER
 
-This program is Copyright 1990,2005 by Johan Vromans.
+This program is Copyright 1990,2007 by Johan Vromans.
 This program is free software; you can redistribute it and/or
 modify it under the terms of the Perl Artistic License or the
 GNU General Public License as published by the Free Software
diff --git a/lib/Getopt/Long/CHANGES b/lib/Getopt/Long/CHANGES
index 21b5596c44..2a22e6df4d 100644
--- a/lib/Getopt/Long/CHANGES
+++ b/lib/Getopt/Long/CHANGES
@@ -1,3 +1,47 @@
+Changes in version 2.36
+-----------------------
+
+**************** WARNING -- EXPERIMENTAL CODE AHEAD ****************
+
+* Parsing options from an arbitrary array
+
+  The entry point GetOptionsFromArray (exported on demand) can be used
+  to parse command line options that are not passed in via @ARGV, but
+  using an arbitrary array.
+
+    use Getopt::Long qw(GetOptionsFromArray);
+    $ret = GetOptionsFromArray(\@myopts, ...);
+
+* Parsing options from an arbitrary string
+
+  The entry point GetOptionsFromString (exported on demand) can be
+  used to parse command line options that are not passed in via @ARGV,
+  but using an arbitrary string.
+
+    use Getopt::Long qw(GetOptionsFromString);
+    $ret = GetOptionsFromString($optstring, ...);
+
+  Note that upon completion, no arguments may remain in the string.
+  If arguments may remain, call it in list context:
+
+    ($ret, $args) = GetOptionsFromString($optstring, ...);
+
+  @$args will have the remaining arguments.
+
+**************** END EXPERIMENTAL CODE ****************
+
+* Number values for options may include underscores for readability
+  (just like Perls numbers).
+
+* Bugfix for Ticket #19432 (found and fixed by khali).
+
+* Bugfix to make it cooperate with the bignum pragma. Thanks to Merijn
+  and Yves.
+
+* Various small fixes to make the test suite run under 5.004_05.
+
+* More examples (skeletons).
+
 Changes in version 2.35
 -----------------------
 
@@ -19,9 +63,7 @@ Changes in version 2.35
 * Bugfix for Ticket #11377 (bug found and fixed by Ryan).
 * Bugfix for Ticket #12380.
 
-**************** WARNING -- EXPERIMENTAL CODE AHEAD ****************
-
-* [Experimental] Options can take multiple values at once. E.g.,
+* Options can take multiple values at once. E.g.,
 
     --coordinates 52.2 16.4 --rgbcolor 255 255 149
 
@@ -34,8 +76,6 @@ Changes in version 2.35
   The syntax for this is similar to that of regular expression
   patterns: { min , max }. 
 
-**************** END EXPERIMENTAL CODE ****************
-
 Changes in version 2.34
 -----------------------
 
diff --git a/lib/Getopt/Long/README b/lib/Getopt/Long/README
index cddaec1e78..fb653f3a35 100644
--- a/lib/Getopt/Long/README
+++ b/lib/Getopt/Long/README
@@ -11,10 +11,10 @@ instead of single letters, and are introduced with a double dash `--'.
 Optionally, Getopt::Long can support the traditional bundling of
 single-letter command line options.
 
-Getopt::Long::GetOptions() is part of the Perl 5 distribution. It is
-the successor of newgetopt.pl that came with Perl 4. It is fully
-upward compatible. In fact, the Perl 5 version of newgetopt.pl is just
-a wrapper around the module.
+Getopt::Long is part of the Perl 5 distribution. It is the successor
+of newgetopt.pl that came with Perl 4. It is fully upward compatible.
+In fact, the Perl 5 version of newgetopt.pl is just a wrapper around
+the module.
 
 For complete documentation, see the Getopt::Long POD document or use
 the command
@@ -200,7 +200,7 @@ Or use the CPAN search engine:
 COPYRIGHT AND DISCLAIMER
 ========================
 
-Module Getopt::Long is Copyright 2005,1990 by Johan Vromans.
+Module Getopt::Long is Copyright 2006,1990 by Johan Vromans.
 This program is free software; you can redistribute it and/or
 modify it under the terms of the Perl Artistic License or the
 GNU General Public License as published by the Free Software
diff --git a/lib/Getopt/Long/t/gol-basic.t b/lib/Getopt/Long/t/gol-basic.t
index 24a71db528..1ad5b75ac5 100644
--- a/lib/Getopt/Long/t/gol-basic.t
+++ b/lib/Getopt/Long/t/gol-basic.t
@@ -20,7 +20,7 @@ print "1..9\n";
 @ARGV = qw(-Foo -baR --foo bar);
 undef $opt_baR;
 undef $opt_bar;
-print "ok 1\n" if GetOptions ("foo", "Foo=s");
+print (GetOptions("foo", "Foo=s") ? "" : "not ", "ok 1\n");
 print ((defined $opt_foo)   ? "" : "not ", "ok 2\n");
 print (($opt_foo == 1)      ? "" : "not ", "ok 3\n");
 print ((defined $opt_Foo)   ? "" : "not ", "ok 4\n");
diff --git a/lib/Getopt/Long/t/gol-linkage.t b/lib/Getopt/Long/t/gol-linkage.t
index 1302471fed..df975c8b31 100644
--- a/lib/Getopt/Long/t/gol-linkage.t
+++ b/lib/Getopt/Long/t/gol-linkage.t
@@ -11,7 +11,7 @@ BEGIN {
 
 use Getopt::Long;
 
-print "1..32\n";
+print "1..33\n";
 
 @ARGV = qw(-Foo -baR --foo bar);
 Getopt::Long::Configure ("no_ignore_case");
@@ -77,3 +77,17 @@ print (!(exists $lnk{bar})   ? "" : "not ", "ok 28\n");
     print ((defined $lnk{Foo})   ? "" : "not ", "ok 31\n");
     print (($lnk{Foo} eq "-baR") ? "" : "not ", "ok 32\n");
 }
+
+{
+    # Allow hashes to overload "".
+    # This used to fail up to 2.34.
+    # Thanks to Yves Orton.
+    my $blessed = bless(\%lnk, "OverLoad::Test");
+
+    @ARGV = qw(--foo bar);
+    Getopt::Long::Configure("default");
+    print "not" unless GetOptions (\%lnk, "foo=s" => \$foo);
+    print "ok 33\n";
+    package Overload::Test;
+    use overload '""' => sub{ die "Bad mojo!" };
+}
diff --git a/lib/Getopt/Long/t/gol-xargv.t b/lib/Getopt/Long/t/gol-xargv.t
new file mode 100644
index 0000000000..52294e8727
--- /dev/null
+++ b/lib/Getopt/Long/t/gol-xargv.t
@@ -0,0 +1,33 @@
+#!./perl -w
+
+no strict;
+
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+	@INC = '../lib';
+	chdir 't';
+    }
+}
+
+use Getopt::Long qw(GetOptionsFromArray :config no_ignore_case);
+my $want_version="2.3501";
+die("Getopt::Long version $want_version required--this is only version ".
+    $Getopt::Long::VERSION)
+  unless $Getopt::Long::VERSION ge $want_version;
+
+print "1..10\n";
+
+my @argv = qw(-Foo -baR --foo bar);
+@ARGV = qw(foo bar);
+undef $opt_baR;
+undef $opt_bar;
+print (GetOptionsFromArray(\@argv, "foo", "Foo=s") ? "" : "not ", "ok 1\n");
+print ((defined $opt_foo)   ? "" : "not ", "ok 2\n");
+print (($opt_foo == 1)      ? "" : "not ", "ok 3\n");
+print ((defined $opt_Foo)   ? "" : "not ", "ok 4\n");
+print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n");
+print ((@argv == 1)         ? "" : "not ", "ok 6\n");
+print (($argv[0] eq "bar")  ? "" : "not ", "ok 7\n");
+print (!(defined $opt_baR)  ? "" : "not ", "ok 8\n");
+print (!(defined $opt_bar)  ? "" : "not ", "ok 9\n");
+print ("@ARGV" eq "foo bar" ? "" : "not ", "ok 10\n");
diff --git a/lib/Getopt/Long/t/gol-xstring.t b/lib/Getopt/Long/t/gol-xstring.t
new file mode 100644
index 0000000000..0d63191383
--- /dev/null
+++ b/lib/Getopt/Long/t/gol-xstring.t
@@ -0,0 +1,54 @@
+#!./perl -w
+
+no strict;
+
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+	@INC = '../lib';
+	chdir 't';
+    }
+}
+
+use Getopt::Long qw(GetOptionsFromString :config no_ignore_case);
+my $want_version="2.3501";
+die("Getopt::Long version $want_version required--this is only version ".
+    $Getopt::Long::VERSION)
+  unless $Getopt::Long::VERSION ge $want_version;
+
+print "1..14\n";
+
+my $args = "-Foo -baR --foo";
+@ARGV = qw(foo bar);
+undef $opt_baR;
+undef $opt_bar;
+print (GetOptionsFromString($args, "foo", "Foo=s") ? "" : "not ", "ok 1\n");
+print ((defined $opt_foo)   ? "" : "not ", "ok 2\n");
+print (($opt_foo == 1)      ? "" : "not ", "ok 3\n");
+print ((defined $opt_Foo)   ? "" : "not ", "ok 4\n");
+print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n");
+print (!(defined $opt_baR)  ? "" : "not ", "ok 6\n");
+print (!(defined $opt_bar)  ? "" : "not ", "ok 7\n");
+print ("@ARGV" eq "foo bar" ? "" : "not ", "ok 8\n");
+
+$args = "-Foo -baR blech --foo bar";
+@ARGV = qw(foo bar);
+undef $opt_baR;
+undef $opt_bar;
+{ my $msg = "";
+  local $SIG{__WARN__} = sub { $msg .= "@_" };
+  my $ret = GetOptionsFromString($args, "foo", "Foo=s");
+  print ($ret ? "not " : "ok 9\n");
+  print ($msg =~ /^GetOptionsFromString: Excess data / ? "" : "$msg\nnot ", "ok 10\n");
+}
+print ("@ARGV" eq "foo bar" ? "" : "not ", "ok 11\n");
+
+$args = "-Foo -baR blech --foo bar";
+@ARGV = qw(foo bar);
+undef $opt_baR;
+undef $opt_bar;
+{ my $ret;
+  ($ret, $args) = GetOptionsFromString($args, "foo", "Foo=s");
+  print ($ret ? "" : "not ", "ok 12\n");
+  print ("@$args" eq "blech bar" ? "" : "@$args\nnot ", "ok 13\n");
+}
+print ("@ARGV" eq "foo bar" ? "" : "not ", "ok 14\n");