Getopt::Long: sync with CPAN version 2.53

From Changes:

* Improve parsing of float numbers.
  https://rt.cpan.org/Ticket/Display.html?id=133216

* Fix Version/HelpMessage -message argument.
  https://rt.cpan.org/Ticket/Display.html?id=133963

* Added 'starter' method to the callback object. This method returns the
  starter (e.g. '--' or '-') of the option as used by the user.

* Fix problem with Pod::Usage argument in examples/skel2.pl.

* Enhanced option:default spec to octal, hex and binary.

2 files changed, 78 insertions, 32 deletions

diff --git a/cpan/Getopt-Long/lib/Getopt/Long.pm b/cpan/Getopt-Long/lib/Getopt/Long.pm
index 8263e21713..0d5b25d908 100644
--- a/cpan/Getopt-Long/lib/Getopt/Long.pm
+++ b/cpan/Getopt-Long/lib/Getopt/Long.pm
@@ -4,8 +4,8 @@
 # Author          : Johan Vromans
 # Created On      : Tue Sep 11 15:00:12 1990
 # Last Modified By: Johan Vromans
-# Last Modified On: Tue Aug 18 14:48:05 2020
-# Update Count    : 1739
+# Last Modified On: Tue Nov 15 14:16:18 2022
+# Update Count    : 1776
 # Status          : Released
 
 ################ Module Preamble ################
@@ -18,10 +18,10 @@ use warnings;
 package Getopt::Long;
 
 use vars qw($VERSION);
-$VERSION        =  2.52;
+$VERSION        =  2.53;
 # For testing versions only.
 use vars qw($VERSION_STRING);
-$VERSION_STRING = "2.52";
+$VERSION_STRING = "2.53";
 
 use Exporter;
 use vars qw(@ISA @EXPORT @EXPORT_OK);
@@ -258,9 +258,9 @@ use constant PAT_XINT  =>
   ")";
 use constant PAT_FLOAT =>
   "[-+]?".			# optional sign
-  "(?=[0-9.])".			# must start with digit or dec.point
+  "(?=\\.?[0-9])".		# must start with digit or dec.point
   "[0-9_]*".			# digits before the dec.point
-  "(\.[0-9_]+)?".		# optional fraction
+  "(\\.[0-9_]*)?".		# optional fraction
   "([eE][-+]?[0-9_]+)?";	# optional exponent
 
 sub GetOptions(@) {
@@ -525,8 +525,9 @@ sub GetOptionsFromArray(@) {
 	my $key;		# key (if hash type)
 	my $arg;		# option argument
 	my $ctl;		# the opctl entry
+	my $starter;		# the actual starter character(s)
 
-	($found, $opt, $ctl, $arg, $key) =
+	($found, $opt, $ctl, $starter, $arg, $key) =
 	  FindOption ($argv, $prefix, $argend, $opt, \%opctl);
 
 	if ( $found ) {
@@ -606,12 +607,13 @@ sub GetOptionsFromArray(@) {
 			    eval {
 				&{$linkage{$opt}}
 				  (Getopt::Long::CallBack->new
-				   (name    => $opt,
-				    given   => $given,
-				    ctl     => $ctl,
-				    opctl   => \%opctl,
-				    linkage => \%linkage,
-				    prefix  => $prefix,
+				   (name     => $opt,
+				    given    => $given,
+				    ctl      => $ctl,
+				    opctl    => \%opctl,
+				    linkage  => \%linkage,
+				    prefix   => $prefix,
+				    starter  => $starter,
 				   ),
 				   $ctl->[CTL_DEST] == CTL_DEST_HASH ? ($key) : (),
 				   $arg);
@@ -818,7 +820,7 @@ sub ParseOptionSpec ($$) {
 		     [=:] [ionfs] [@%]? (?: \{\d*,?\d*\} )?
 		     |
 		     # ... or an optional-with-default spec
-		     : (?: -?\d+ | \+ ) [@%]?
+		     : (?: 0[0-7]+ | 0[xX][0-9a-fA-F]+ | 0[bB][01]+ | -?\d+ | \+ ) [@%]?
 		   )?
 		   $;x ) {
 	return (undef, "Error in option spec: \"$opt\"\n");
@@ -851,10 +853,23 @@ sub ParseOptionSpec ($$) {
 	# Fields are hard-wired here.
 	$entry = [$spec,$orig,undef,CTL_DEST_SCALAR,0,0];
     }
-    elsif ( $spec =~ /^:(-?\d+|\+)([@%])?$/ ) {
+    elsif ( $spec =~ /^:(0[0-7]+|0x[0-9a-f]+|0b[01]+|-?\d+|\+)([@%])?$/i ) {
 	my $def = $1;
 	my $dest = $2;
-	my $type = $def eq '+' ? 'I' : 'i';
+	my $type = 'i';		# assume integer
+	if ( $def eq '+' ) {
+	    # Increment.
+	    $type = 'I';
+	}
+	elsif ( $def =~ /^(0[0-7]+|0[xX][0-9a-fA-F]+|0[bB][01]+)$/ ) {
+	    # Octal, binary or hex.
+	    $type = 'o';
+	    $def = oct($def);
+	}
+	elsif ( $def =~ /^-?\d+$/ ) {
+	    # Integer.
+	    $def = 0 + $def;
+	}
 	$dest ||= '$';
 	$dest = $dest eq '@' ? CTL_DEST_ARRAY
 	  : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
@@ -923,7 +938,7 @@ sub ParseOptionSpec ($$) {
 # Option lookup.
 sub FindOption ($$$$$) {
 
-    # returns (1, $opt, $ctl, $arg, $key) if okay,
+    # returns (1, $opt, $ctl, $starter, $arg, $key) if okay,
     # returns (1, undef) if option in error,
     # returns (0) otherwise.
 
@@ -1104,7 +1119,7 @@ sub FindOption ($$$$$) {
 	    $arg = 0;		# supply explicit value
 	}
 	unshift (@$argv, $starter.$rest) if defined $rest;
-	return (1, $opt, $ctl, $arg);
+	return (1, $opt, $ctl, $starter, $arg);
     }
 
     # Get mandatory status and type info.
@@ -1127,15 +1142,15 @@ sub FindOption ($$$$$) {
 		# Fake incremental type.
 		my @c = @$ctl;
 		$c[CTL_TYPE] = '+';
-		return (1, $opt, \@c, 1);
+		return (1, $opt, \@c, $starter, 1);
 	    }
 	    my $val
 	      = defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT]
 	      : $type eq 's'                 ? ''
 	      :                                0;
-	    return (1, $opt, $ctl, $val);
+	    return (1, $opt, $ctl, $starter, $val);
 	}
-	return (1, $opt, $ctl, $type eq 's' ? '' : 0)
+	return (1, $opt, $ctl, $starter, $type eq 's' ? '' : 0)
 	  if $optargtype == 1;  # --foo=  -> return nothing
     }
 
@@ -1155,9 +1170,9 @@ sub FindOption ($$$$$) {
 	    # Fake incremental type.
 	    my @c = @$ctl;
 	    $c[CTL_TYPE] = '+';
-	    return (1, $opt, \@c, 1);
+	    return (1, $opt, \@c, $starter, 1);
 	}
-	return (1, $opt, $ctl,
+	return (1, $opt, $ctl, $starter,
 		defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
 		$type eq 's' ? '' : 0);
     }
@@ -1187,16 +1202,16 @@ sub FindOption ($$$$$) {
 
     if ( $type eq 's' ) {	# string
 	# A mandatory string takes anything.
-	return (1, $opt, $ctl, $arg, $key) if $mand;
+	return (1, $opt, $ctl, $starter, $arg, $key) if $mand;
 
 	# Same for optional string as a hash value
-	return (1, $opt, $ctl, $arg, $key)
+	return (1, $opt, $ctl, $starter, $arg, $key)
 	  if $ctl->[CTL_DEST] == CTL_DEST_HASH;
 
 	# An optional string takes almost anything.
-	return (1, $opt, $ctl, $arg, $key)
+	return (1, $opt, $ctl, $starter, $arg, $key)
 	  if defined $optarg || defined $rest;
-	return (1, $opt, $ctl, $arg, $key) if $arg eq "-"; # ??
+	return (1, $opt, $ctl, $starter, $arg, $key) if $arg eq "-"; # ??
 
 	# Check for option or option list terminator.
 	if ($arg eq $argend ||
@@ -1248,7 +1263,7 @@ sub FindOption ($$$$$) {
 		    # Fake incremental type.
 		    my @c = @$ctl;
 		    $c[CTL_TYPE] = '+';
-		    return (1, $opt, \@c, 1);
+		    return (1, $opt, \@c, $starter, 1);
 		}
 		# Supply default value.
 		$arg = defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : 0;
@@ -1293,7 +1308,7 @@ sub FindOption ($$$$$) {
     else {
 	die("Getopt::Long internal error (Can't happen)\n");
     }
-    return (1, $opt, $ctl, $arg, $key);
+    return (1, $opt, $ctl, $starter, $arg, $key);
 }
 
 sub ValidValue ($$$$$) {
@@ -1529,8 +1544,7 @@ sub setup_pa_args($@) {
 
     if ( UNIVERSAL::isa($pa, 'HASH') ) {
 	# Get rid of -msg vs. -message ambiguity.
-	$pa->{-message} = $pa->{-msg};
-	delete($pa->{-msg});
+	$pa->{-message} //= delete($pa->{-msg});
     }
     elsif ( $pa =~ /^-?\d+$/ ) {
 	$pa = { -exitval => $pa };
@@ -1714,6 +1728,9 @@ disable C<$verbose> by setting its value to C<0>. Using a suitable
 default value, the program can find out whether C<$verbose> is false
 by default, or disabled by using C<--noverbose>.
 
+(If both C<--verbose> and C<--noverbose> are given, whichever is given
+last takes precedence.)
+
 An incremental option is specified with a plus C<+> after the
 option name:
 
@@ -1766,6 +1783,10 @@ of the equals sign indicates that the option value is optional. In
 this case, if no suitable value is supplied, string valued options get
 an empty string C<''> assigned, while numeric options are set to C<0>.
 
+(If the same option appears more than once on the command line, the
+last given value is used.  If you want to take all the values, see
+below.)
+
 =head2 Options with multiple values
 
 Options sometimes take several values. For example, a program could
@@ -2010,6 +2031,8 @@ considered an option on itself.
 
 Like C<:i>, but if the value is omitted, the I<number> will be assigned.
 
+If the I<number> is octal, hexadecimal or binary, behaves like C<:o>.
+
 =item : + [ I<desttype> ]
 
 Like C<:i>, but if the value is omitted, the current value for the
diff --git a/cpan/Getopt-Long/t/gol-basic.t b/cpan/Getopt-Long/t/gol-basic.t
index 16bb2d02fc..5bbde72f60 100644
--- a/cpan/Getopt-Long/t/gol-basic.t
+++ b/cpan/Getopt-Long/t/gol-basic.t
@@ -15,7 +15,7 @@ die("Getopt::Long version $want_version required--this is only version ".
     $Getopt::Long::VERSION)
   unless $Getopt::Long::VERSION ge $want_version;
 
-print "1..12\n";
+print "1..18\n";
 
 @ARGV = qw(-Foo -baR --foo bar);
 undef $opt_baR;
@@ -43,3 +43,26 @@ print ($rv ? "" : "not "); print "ok 10\n";
 print ("@ARGV" eq 'file' ? "" : "not ", "ok 11\n");
 ( $HELP && $FOO && !$BAR && $FILE eq 'foo' && $NO == 5 )
     ? print "" : print "not "; print "ok 12\n";
+
+# Test behaviour when the same option name is given twice, but not an multi-value option.
+# The option given later on the command line is used.
+#
+{
+    my $foo;
+
+    @ARGV = qw(--foo a --foo b);
+    $rd = GetOptions('foo=s' => \$foo);
+    print ($rv ? "" : "not "); print "ok 13\n";
+    print ($foo eq 'b' ? "" : "not ", "ok 14\n");
+
+    @ARGV = qw(--no-foo --foo);
+    $rd = GetOptions('foo!' => \$foo);
+    print ($rv ? "" : "not "); print "ok 15\n";
+    print ($foo eq '1' ? "" : "not ", "ok 16\n");
+
+    @ARGV = qw(--foo --no-foo);
+    $rd = GetOptions('foo!' => \$foo);
+    print ($rv ? "" : "not "); print "ok 17\n";
+    # Check it is set to an explicit 0.
+    print ($foo eq '0' ? "" : "not ", "ok 18\n");
+}