Upgrade to Getopt::Long 2.34_04

p4raw-id: //depot/perl@26216

6 files changed, 87 insertions, 13 deletions

diff --git a/lib/Getopt/Long/CHANGES b/lib/Getopt/Long/CHANGES
index 2c77c5e5c1..21b5596c44 100644
--- a/lib/Getopt/Long/CHANGES
+++ b/lib/Getopt/Long/CHANGES
@@ -1,6 +1,26 @@
 Changes in version 2.35
 -----------------------
 
+* long_prefix_pattern configuration variable.
+
+  prefix_pattern has now been complemented by a new configuration
+  option 'long_prefix_pattern' that allows the user to specify what
+  prefix patterns should have long option style sematics applied.
+  This will enable people to do things like
+
+    foo.pl /option=value
+
+  instead of forcing people to use the short option style
+
+    foo.pl /option value
+
+  This enhancement was suggested and implemented by Yves Orton.
+
+* 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.,
 
     --coordinates 52.2 16.4 --rgbcolor 255 255 149
@@ -14,6 +34,8 @@ 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
 -----------------------
 
@@ -39,8 +61,6 @@ Changes in version 2.34
 Changes in version 2.33
 -----------------------
 
-**************** WARNING -- EXPERIMENTAL CODE AHEAD ****************
-
 The following new features are marked experimental. This means that if
 you are going to use them you _must_ watch out for the next release of
 Getopt::Long to see if the API has changed.
@@ -83,8 +103,6 @@ Getopt::Long to see if the API has changed.
     use Getopt::Long 2.33 qw(GetOptions HelpMessage);
     GetOptions(...) or HelpMessage(2);
 
-**************** END EXPERIMENTAL CODE ****************
-
 * Subroutine Configure can now be exported on demand.
 
 * Negatable options (with "!") now also support the "no-" prefix.
diff --git a/lib/Getopt/Long/README b/lib/Getopt/Long/README
index 691253ded6..cddaec1e78 100644
--- a/lib/Getopt/Long/README
+++ b/lib/Getopt/Long/README
@@ -69,6 +69,7 @@ By default, single-letter option names are case sensitive.
     "nodebug" will switch it off.    
   - options can set values, but also add values producing an array
     of values instead of a single scalar value, or set values in a hash.
+  - options can have multiple values, e.g., "--position 25 624".
 
 * Options linkage
 
@@ -162,8 +163,15 @@ to reverse the effect:
   - prefix_pattern
 
 	A Perl pattern that identifies the strings that introduce
-	options. Default is (--|-|\+) unless environment variable
-	POSIXLY_CORRECT has been set, in which case it is (--|-).
+	options. Default is --|-|\+ unless environment variable
+	POSIXLY_CORRECT has been set, in which case it is --|-.
+
+  - long_prefix_pattern
+
+        A perl pattern that is used to identify which prefixes
+        should be treated as long style. Any prefixes that don't
+        match this pattern will have short option semantics.
+        Defaults to --.
 
   - debug
 
@@ -192,7 +200,7 @@ Or use the CPAN search engine:
 COPYRIGHT AND DISCLAIMER
 ========================
 
-Module Getopt::Long is Copyright 2003,1990 by Johan Vromans.
+Module Getopt::Long is Copyright 2005,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
@@ -201,6 +209,6 @@ later version.
 
 -------------------------------------------------------------------
 Johan Vromans                                  jvromans@squirrel.nl
-Squirrel Consultancy                       Haarlem, the Netherlands
+Squirrel Consultancy                         Exloo, the Netherlands
 http://www.squirrel.nl       http://www.squirrel.nl/people/jvromans
 ------------------ "Arms are made for hugging" --------------------
diff --git a/lib/Getopt/Long/t/gol-basic.t b/lib/Getopt/Long/t/gol-basic.t
index f1916b291c..24a71db528 100644
--- a/lib/Getopt/Long/t/gol-basic.t
+++ b/lib/Getopt/Long/t/gol-basic.t
@@ -1,5 +1,7 @@
 #!./perl -w
 
+no strict;
+
 BEGIN {
     if ($ENV{PERL_CORE}) {
 	@INC = '../lib';
@@ -8,9 +10,10 @@ BEGIN {
 }
 
 use Getopt::Long qw(:config no_ignore_case);
-die("Getopt::Long version 2.23_03 required--this is only version ".
+my $want_version="2.24";
+die("Getopt::Long version $want_version required--this is only version ".
     $Getopt::Long::VERSION)
-  unless $Getopt::Long::VERSION ge "2.24";
+  unless $Getopt::Long::VERSION ge $want_version;
 
 print "1..9\n";
 
diff --git a/lib/Getopt/Long/t/gol-compat.t b/lib/Getopt/Long/t/gol-compat.t
index e211eeaec7..c123ef27f1 100644
--- a/lib/Getopt/Long/t/gol-compat.t
+++ b/lib/Getopt/Long/t/gol-compat.t
@@ -1,5 +1,7 @@
 #!./perl -w
 
+no strict;
+
 BEGIN {
     if ($ENV{PERL_CORE}) {
 	@INC = '../lib';
diff --git a/lib/Getopt/Long/t/gol-linkage.t b/lib/Getopt/Long/t/gol-linkage.t
index a3047cfc19..1302471fed 100644
--- a/lib/Getopt/Long/t/gol-linkage.t
+++ b/lib/Getopt/Long/t/gol-linkage.t
@@ -1,5 +1,7 @@
 #!./perl -w
 
+no strict;
+
 BEGIN {
     if ($ENV{PERL_CORE}) {
 	@INC = '../lib';
@@ -9,7 +11,7 @@ BEGIN {
 
 use Getopt::Long;
 
-print "1..18\n";
+print "1..32\n";
 
 @ARGV = qw(-Foo -baR --foo bar);
 Getopt::Long::Configure ("no_ignore_case");
@@ -37,3 +39,41 @@ print (($ARGV[0] eq "bar")   ? "" : "not ", "ok 15\n");
 print (!(exists $lnk{foo})   ? "" : "not ", "ok 16\n");
 print (!(exists $lnk{baR})   ? "" : "not ", "ok 17\n");
 print (!(exists $lnk{bar})   ? "" : "not ", "ok 18\n");
+
+@ARGV = qw(/Foo=-baR --bar bar);
+Getopt::Long::Configure ("default","prefix_pattern=--|/|-|\\+","long_prefix_pattern=--|/");
+%lnk = ();
+my $bar;
+print "ok 19\n" if GetOptions (\%lnk, "bar" => \$bar, "Foo=s");
+print ((defined $bar)        ? "" : "not ", "ok 20\n");
+print (($bar == 1)           ? "" : "not ", "ok 21\n");
+print ((defined $lnk{Foo})   ? "" : "not ", "ok 22\n");
+print (($lnk{Foo} eq "-baR") ? "" : "not ", "ok 23\n");
+print ((@ARGV == 1)          ? "" : "not ", "ok 24\n");
+print (($ARGV[0] eq "bar")   ? "" : "not ", "ok 25\n");
+print (!(exists $lnk{foo})   ? "" : "not ", "ok 26\n");
+print (!(exists $lnk{baR})   ? "" : "not ", "ok 27\n");
+print (!(exists $lnk{bar})   ? "" : "not ", "ok 28\n");
+{
+    my $errors;
+    %lnk = ();
+    local $SIG{__WARN__}= sub { $errors.=join("\n",@_,'') };
+
+    @ARGV = qw(/Foo=-baR);
+    Getopt::Long::Configure ("default","bundling","ignore_case_always",
+                             "prefix_pattern=--|/|-|\\+","long_prefix_pattern=--");
+    %lnk = ();
+    undef $bar;
+    GetOptions (\%lnk, "bar" => \$bar, "Foo=s");
+    print (($errors=~/Unknown option:/) ? "" : "not ", "ok 29\n");
+    $errors="";
+    %lnk = ();
+    undef $bar;
+     @ARGV = qw(/Foo=-baR);
+    Getopt::Long::Configure ("default","bundling","ignore_case_always",
+                             "prefix_pattern=--|/|-|\\+","long_prefix_pattern=--|/");
+    GetOptions (\%lnk, "bar" => \$bar, "Foo=s");
+    print (($errors eq '') ? "" : "not ", "ok 30\n");
+    print ((defined $lnk{Foo})   ? "" : "not ", "ok 31\n");
+    print (($lnk{Foo} eq "-baR") ? "" : "not ", "ok 32\n");
+}
diff --git a/lib/Getopt/Long/t/gol-oo.t b/lib/Getopt/Long/t/gol-oo.t
index f8191d1db1..df49cb63b2 100644
--- a/lib/Getopt/Long/t/gol-oo.t
+++ b/lib/Getopt/Long/t/gol-oo.t
@@ -1,5 +1,7 @@
 #!./perl -w
 
+no strict;
+
 BEGIN {
     if ($ENV{PERL_CORE}) {
 	@INC = '../lib';
@@ -8,9 +10,10 @@ BEGIN {
 }
 
 use Getopt::Long;
-die("Getopt::Long version 2.23_03 required--this is only version ".
+my $want_version="2.24";
+die("Getopt::Long version $want_version required--this is only version ".
     $Getopt::Long::VERSION)
-  unless $Getopt::Long::VERSION ge "2.24";
+  unless $Getopt::Long::VERSION ge $want_version;
 print "1..9\n";
 
 @ARGV = qw(-Foo -baR --foo bar);