From: Rafael Garcia-Suarez Date: Sat, 17 May 2003 12:10:14 +0000 (+0000) Subject: Upgrade to Getopt::Long 2.32_05 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=10933be5b2abdb147e3178c33da9bc6edc90eaee;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Getopt::Long 2.32_05 p4raw-id: //depot/perl@19541 --- diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm index 7e1663d..8ee2322 100644 --- a/lib/Getopt/Long.pm +++ b/lib/Getopt/Long.pm @@ -1,13 +1,13 @@ -# GetOpt::Long.pm -- Universal options parsing +# Getopt::Long.pm -- Universal options parsing package Getopt::Long; -# RCS Status : $Id: GetoptLong.pm,v 2.58 2002-06-20 09:32:09+02 jv Exp $ +# RCS Status : $Id: GetoptLong.pm,v 2.63 2003-04-04 18:44:03+02 jv Exp jv $ # Author : Johan Vromans # Created On : Tue Sep 11 15:00:12 1990 # Last Modified By: Johan Vromans -# Last Modified On: Thu Jun 20 07:48:05 2002 -# Update Count : 1083 +# Last Modified On: Thu May 15 14:48:48 2003 +# Update Count : 1321 # Status : Released ################ Copyright ################ @@ -35,20 +35,25 @@ use 5.004; use strict; use vars qw($VERSION); -$VERSION = 2.32; +$VERSION = 2.3205; # For testing versions only. use vars qw($VERSION_STRING); -$VERSION_STRING = "2.32"; +$VERSION_STRING = "2.32_05"; use Exporter; - -use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); +use vars qw(@ISA @EXPORT @EXPORT_OK); @ISA = qw(Exporter); -%EXPORT_TAGS = qw(); + +# Exported subroutines. +sub GetOptions(@); # always +sub Configure(@); # on demand +sub HelpMessage(@); # on demand +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(); + @EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER); + @EXPORT_OK = qw(&HelpMessage &VersionMessage &Configure); } # User visible variables. @@ -58,24 +63,27 @@ use vars qw($error $debug $major_version $minor_version); use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order $passthrough); # Official invisible variables. -use vars qw($genprefix $caller $gnu_compat); +use vars qw($genprefix $caller $gnu_compat $auto_help $auto_version); # Public subroutines. -sub Configure (@); -sub config (@); # deprecated name -sub GetOptions; +sub config(@); # deprecated name # Private subroutines. -sub ConfigDefaults (); -sub ParseOptionSpec ($$); -sub OptCtl ($); -sub FindOption ($$$$); +sub ConfigDefaults(); +sub ParseOptionSpec($$); +sub OptCtl($); +sub FindOption($$$$); ################ Local Variables ################ +# $requested_version holds the version that was mentioned in the 'use' +# or 'require', if any. It can be used to enable or disable specific +# features. +my $requested_version = 0; + ################ Resident subroutines ################ -sub ConfigDefaults () { +sub ConfigDefaults() { # Handle POSIX compliancy. if ( defined $ENV{"POSIXLY_CORRECT"} ) { $genprefix = "(--|-)"; @@ -97,6 +105,10 @@ sub ConfigDefaults () { $ignorecase = 1; # ignore case when matching options $passthrough = 0; # leave unrecognized options alone $gnu_compat = 0; # require --opt=val if value is optional + + # Version-dependent defaults. Leave undefined. + # $auto_help = $requested_version >= 2.3203; # supply --help handler + # $auto_version = $requested_version >= 2.3203; # supply --version handler } # Override import. @@ -110,13 +122,14 @@ sub import { $dest = \@config; # config next next; } - push (@$dest, $_); # push + push(@$dest, $_); # push } # Hide one level and call super. local $Exporter::ExportLevel = 1; + push(@syms, qw(&GetOptions)) if @syms; # always export GetOptions $pkg->SUPER::import(@syms); # And configure. - Configure (@config) if @config; + Configure(@config) if @config; } ################ Initialization ################ @@ -205,6 +218,8 @@ sub getoptions { package Getopt::Long; +################ Back to Normal ################ + # Indices in option control info. # Note that ParseOptions uses the fields directly. Search for 'hard-wired'. use constant CTL_TYPE => 0; @@ -233,7 +248,7 @@ use constant CTL_DEFAULT => 4; #use constant CTL_RANGE => ; #use constant CTL_REPEAT => ; -sub GetOptions { +sub GetOptions(@) { my @optionlist = @_; # local copy of the option descriptions my $argend = '--'; # option list terminator @@ -248,8 +263,8 @@ sub GetOptions { $error = ''; - print STDERR ("GetOpt::Long $Getopt::Long::VERSION (", - '$Revision: 2.58 $', ") ", + print STDERR ("Getopt::Long $Getopt::Long::VERSION (", + '$Revision: 2.63 $', ") ", "called from package \"$pkg\".", "\n ", "ARGV: (@ARGV)", @@ -261,6 +276,8 @@ sub GetOptions { "order=$order,", "\n ", "ignorecase=$ignorecase,", + "autohelp=$auto_help,", + "autoversion=$auto_version,", "passthrough=$passthrough,", "genprefix=\"$genprefix\".", "\n") @@ -392,6 +409,20 @@ sub GetOptions { die ($error) if $error; $error = 0; + # Supply --version and --help support, if needed and allowed. + if ( defined($auto_version) ? $auto_version : ($requested_version >= 2.3203) ) { + if ( !defined($opctl{version}) ) { + $opctl{version} = ['','version',0,CTL_DEST_CODE,undef]; + $linkage{version} = \&VersionMessage; + } + } + if ( defined($auto_help) ? $auto_help : ($requested_version >= 2.3203) ) { + if ( !defined($opctl{help}) && !defined($opctl{'?'}) ) { + $opctl{help} = $opctl{'?'} = ['','help',0,CTL_DEST_CODE,undef]; + $linkage{help} = \&HelpMessage; + } + } + # Show the options tables if debugging. if ( $debug ) { my ($arrow, $k, $v); @@ -411,7 +442,10 @@ sub GetOptions { print STDERR ("=> arg \"", $opt, "\"\n") if $debug; # Double dash is option list terminator. - last if $opt eq $argend; + if ( $opt eq $argend ) { + push (@ret, $argend) if $passthrough; + last; + } # Look it up. my $tryopt = $opt; @@ -698,6 +732,7 @@ sub ParseOptionSpec ($$) { if ( $spec eq '!' ) { $opctl->{"no$_"} = $entry; + $opctl->{"no-$_"} = $entry; $opctl->{$_} = [@$entry]; $opctl->{$_}->[CTL_TYPE] = ''; } @@ -853,7 +888,7 @@ sub FindOption ($$$$) { $arg = 1; } else { - $opt =~ s/^no//i; # strip NO prefix + $opt =~ s/^no-?//i; # strip NO prefix $arg = 0; # supply explicit value } unshift (@ARGV, $starter.$rest) if defined $rest; @@ -899,11 +934,21 @@ sub FindOption ($$$$) { my $key; if ($ctl->[CTL_DEST] == CTL_DEST_HASH && defined $arg) { ($key, $arg) = ($arg =~ /^([^=]*)=(.*)$/s) ? ($1, $2) - : ($arg, defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : 1); + : ($arg, defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : + ($mand ? undef : ($type eq 's' ? "" : 1))); + if (! defined $arg) { + warn ("Option $opt, key \"$key\", requires a value\n"); + $error++; + # Push back. + unshift (@ARGV, $starter.$rest) if defined $rest; + return (1, undef); + } } #### Check if the argument is valid for this option #### + my $key_valid = $ctl->[CTL_DEST] == CTL_DEST_HASH ? "[^=]+=" : ""; + if ( $type eq 's' ) { # string # A mandatory string takes anything. return (1, $opt, $ctl, $arg, $key) if $mand; @@ -931,9 +976,10 @@ sub FindOption ($$$$) { $type eq 'o' ? "[-+]?[1-9][0-9]*|0x[0-9a-f]+|0b[01]+|0[0-7]*" : "[-+]?[0-9]+"; - if ( $bundling && defined $rest && $rest =~ /^($o_valid)(.*)$/si ) { - $arg = $1; - $rest = $2; + 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 ''; } @@ -976,9 +1022,9 @@ sub FindOption ($$$$) { # and at least one digit following the point and 'e'. # [-]NN[.NN][eNN] if ( $bundling && defined $rest && - $rest =~ /^([-+]?[0-9]+(\.[0-9]+)?([eE][-+]?[0-9]+)?)(.*)$/s ) { - $arg = $1; - $rest = $+; + $rest =~ /^($key_valid)([-+]?[0-9]+(\.[0-9]+)?([eE][-+]?[0-9]+)?)(.*)$/s ) { + ($key, $arg, $rest) = ($1, $2, $+); + chop($key) if $key; unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne ''; } elsif ( $arg !~ /^[-+]?[0-9.]+(\.[0-9]+)?([eE][-+]?[0-9]+)?$/ ) { @@ -1004,7 +1050,7 @@ sub FindOption ($$$$) { } } else { - die("GetOpt::Long internal error (Can't happen)\n"); + die("Getopt::Long internal error (Can't happen)\n"); } return (1, $opt, $ctl, $arg, $key); } @@ -1016,12 +1062,13 @@ sub Configure (@) { my $prevconfig = [ $error, $debug, $major_version, $minor_version, $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order, - $gnu_compat, $passthrough, $genprefix ]; + $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help ]; if ( ref($options[0]) eq 'ARRAY' ) { ( $error, $debug, $major_version, $minor_version, $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order, - $gnu_compat, $passthrough, $genprefix ) = @{shift(@options)}; + $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help ) = + @{shift(@options)}; } my $opt; @@ -1057,6 +1104,12 @@ sub Configure (@) { elsif ( $try eq 'gnu_compat' ) { $gnu_compat = $action; } + elsif ( $try =~ /^(auto_?)?version$/ ) { + $auto_version = $action; + } + elsif ( $try =~ /^(auto_?)?help$/ ) { + $auto_help = $action; + } elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) { $ignorecase = $action; } @@ -1108,6 +1161,100 @@ sub config (@) { Configure (@_); } +# Issue a standard message for --version. +# +# The arguments are mostly the same as for Pod::Usage::pod2usage: +# +# - a number (exit value) +# - a string (lead in message) +# - a hash with options. See Pod::Usage for details. +# +sub VersionMessage(@) { + # Massage args. + my $pa = setup_pa_args("version", @_); + + my $v = $main::VERSION; + my $fh = $pa->{-output} || + ($pa->{-exitval} eq "NOEXIT" || $pa->{-exitval} < 2) ? \*STDOUT : \*STDERR; + + print $fh (defined($pa->{-message}) ? $pa->{-message} : (), + $0, defined $v ? " version $v" : (), + "\n", + "(", __PACKAGE__, "::", "GetOptions", + " version ", + defined($VERSION_STRING) ? $VERSION_STRING : $VERSION, ";", + " Perl version ", + $] >= 5.006 ? sprintf("%vd", $^V) : $], + ")\n"); + exit($pa->{-exitval}) unless $pa->{-exitval} eq "NOEXIT"; +} + +# Issue a standard message for --help. +# +# The arguments are the same as for Pod::Usage::pod2usage: +# +# - a number (exit value) +# - a string (lead in message) +# - a hash with options. See Pod::Usage for details. +# +sub HelpMessage(@) { + eval { + require Pod::Usage; + import Pod::Usage; + 1; + } || die("Cannot provide help: cannot load Pod::Usage\n"); + + # Note that pod2usage will issue a warning if -exitval => NOEXIT. + pod2usage(setup_pa_args("help", @_)); + +} + +# Helper routine to set up a normalized hash ref to be used as +# argument to pod2usage. +sub setup_pa_args($@) { + my $tag = shift; # who's calling + + # If called by direct binding to an option, it will get the option + # name and value as arguments. Remove these, if so. + @_ = () if @_ == 2 && $_[0] eq $tag; + + my $pa; + if ( @_ > 1 ) { + $pa = { @_ }; + } + else { + $pa = shift || {}; + } + + # At this point, $pa can be a number (exit value), string + # (message) or hash with options. + + if ( UNIVERSAL::isa($pa, 'HASH') ) { + # Get rid of -msg vs. -message ambiguity. + $pa->{-message} = $pa->{-msg}; + delete($pa->{-msg}); + } + elsif ( $pa =~ /^-?\d+$/ ) { + $pa = { -exitval => $pa }; + } + else { + $pa = { -message => $pa }; + } + + # These are _our_ defaults. + $pa->{-verbose} = 0 unless exists($pa->{-verbose}); + $pa->{-exitval} = 0 unless exists($pa->{-exitval}); + $pa; +} + +# Sneak way to know what version the user requested. +sub VERSION { + $requested_version = $_[1]; + shift->SUPER::VERSION(@_); +} + +1; + ################ Documentation ################ =head1 NAME @@ -1425,7 +1572,7 @@ The argument specification can be The option does not take an argument and may be negated, i.e. prefixed by "no". E.g. C<"foo!"> will allow C<--foo> (a value of 1 will be -assigned) and C<--nofoo> (a value of 0 will be assigned). If the +assigned) and C<--nofoo> and C<--no-foo> (a value of 0 will be assigned). If the option has aliases, this applies to the aliases as well. Using negation on a single letter option when bundling is in effect is @@ -1538,7 +1685,7 @@ messages. For example: =head1 NAME - sample - Using GetOpt::Long and Pod::Usage + sample - Using Getopt::Long and Pod::Usage =head1 SYNOPSIS @@ -1689,7 +1836,7 @@ it will set variable C<$stdio>. =head2 Argument callback -A special option 'name' C<<>> can be used to designate a subroutine +A special option 'name' C<< <> >> can be used to designate a subroutine to handle non-option arguments. When GetOptions() encounters an argument that does not look like an option, it will immediately call this subroutine and passes it one parameter: the argument name. @@ -1712,7 +1859,6 @@ C while C<$width> is C<60>. This feature requires configuration option B, see section L. - =head1 Configuring Getopt::Long Getopt::Long can be configured by calling subroutine @@ -1861,6 +2007,25 @@ options also. Note: disabling C also disables C. +=item auto_version (default:disabled) + +Automatically provide support for the B<--version> option if +the application did not specify a handler for this option itself. + +Getopt::Long will provide a standard version message that includes the +program name, its version (if $main::VERSION is defined), and the +versions of Getopt::Long and Perl. The message will be written to +standard output and processing will terminate. + +=item auto_help (default:disabled) + +Automatically provide support for the B<--help> and B<-?> options if +the application did not specify a handler for this option itself. + +Getopt::Long will provide a help message using module Pod::Usage. The +message, derived from the SYNOPSIS POD section, will be written to +standard output and processing will terminate. + =item pass_through (default: disabled) Options that are unknown, ambiguous or supplied with an invalid option @@ -1873,6 +2038,9 @@ If C is enabled, options processing will terminate at the first unrecognized option, or non-option, whichever comes first. However, if C is enabled instead, results can become confusing. +Note that the options terminator (default C<-->), if present, will +also be passed through in C<@ARGV>. + =item prefix The string that starts options. If a constant string is not @@ -1890,6 +2058,83 @@ Enable debugging output. =back +=head1 Exportable Methods + +=over + +=item VersionMessage + +This subroutine provides a standard version message. Its argument can be: + +=over 4 + +=item * + +A string containing the text of a message to print I printing +the standard message. + +=item * + +A numeric value corresponding to the desired exit status. + +=item * + +A reference to a hash. + +=back + +If more than one argument is given then the entire argument list is +assumed to be a hash. If a hash is supplied (either as a reference or +as a list) it should contain one or more elements with the following +keys: + +=over 4 + +=item C<-message> + +=item C<-msg> + +The text of a message to print immediately prior to printing the +program's usage message. + +=item C<-exitval> + +The desired exit status to pass to the B function. +This should be an integer, or else the string "NOEXIT" to +indicate that control should simply be returned without +terminating the invoking process. + +=item C<-output> + +A reference to a filehandle, or the pathname of a file to which the +usage message should be written. The default is C<\*STDERR> unless the +exit value is less than 2 (in which case the default is C<\*STDOUT>). + +=back + +You cannot tie this routine directly to an option, e.g.: + + GetOptions("version" => \&VersionMessage); + +Use this instead: + + GetOptions("version" => sub { VersionMessage() }); + +=item HelpMessage + +This subroutine produces a standard help message, derived from the +program's POD section SYNOPSIS using Pod::Usage. It takes the same +arguments as VersionMessage(). In particular, you cannot tie it +directly to an option, e.g.: + + GetOptions("help" => \&HelpMessage); + +Use this instead: + + GetOptions("help" => sub { HelpMessage() }); + +=back + =head1 Return values and Errors Configuration errors and errors in the option definitions are @@ -1902,8 +2147,6 @@ It returns false when the function detected one or more errors during option parsing. These errors are signalled using warn() and can be trapped with C<$SIG{__WARN__}>. -Errors that can't happen are signalled using Carp::croak(). - =head1 Legacy The earliest development of C started in 1990, with Perl @@ -2014,6 +2257,14 @@ program: to verify how your CLI passes the arguments to the program. +=head2 Undefined subroutine &main::GetOptions called + +Are you running Windows, and did you write + + use GetOpt::Long; + +(note the capital 'O')? + =head2 How do I put a "-?" option into a Getopt::Long? You can only obtain this using an alias, and Getopt::Long of at least diff --git a/lib/Getopt/Long/CHANGES b/lib/Getopt/Long/CHANGES index 5ed7d90..c2de0f6 100644 --- a/lib/Getopt/Long/CHANGES +++ b/lib/Getopt/Long/CHANGES @@ -1,3 +1,66 @@ +Changes in version 2.33 +----------------------- + +**************** WARNING -- EXPERIMENTAL CODE AHEAD **************** + +* Getopt::Long can automatically handle --version and --help options + if the calling program did not specify a handler explicitly. + + Two configuration parameters have been added: 'auto_help' (or + 'help') and 'auto_version' (or 'version'). If set, Getopt::Long will + itself take care of --help and --version options. Otherwise, + everything is exactly as it was before. + + The new features will be enabled by default for programs that + explicitly require version 2.3203 or later. + + Getopt::Long uses module Pod::Usage to produce the help message from + the SYNOPSIS section of the program's POD. + + Using a --help (or -?) command line option will write the SYNOPSIS + section of the program's POD to STDOUT, and exit with status 0. + However, an illegal option will produce the help text to STDERR, + and exit with status 2. This is in accordance with current + conventions. + +* Two subroutines can be exported on demand: + + - VersionMessage + + This subroutine prints the standard version message. + + - HelpMessage + + This subroutine prints the standard help message. + + Both subroutines take the same arguments as Pod::Usage::pod2usage, + see its documentation for details. + + Example: + + use Getopt::Long 2.3203 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. + On request of Ed Avis . + +* Some fixes with hashes and bundling. + Thanks to Anders Johnson and Andrei Gnepp <>. + Mandatory/optional status for hash values is now effective. + String valued options with no value now default to the empty string + instead of 1 (one). + NOTE: The hash options still remain more or less experimental. + +* Fix a pass_through bug where the options terminator (normally "--") + was not passed through in @ARGV. + Thanks to Philippe Verdret . + +* Add FAQ: I "use GetOpt::Long;" (Windows) and now it doesn't work. + Changes in version 2.32 ----------------------- @@ -7,6 +70,21 @@ was not used for value of a hash option. * Remove 5.005 thread safety code. Getopt::Long is completely thread safe when using the 5.8 ithreads. +Changes in version 2.31 +----------------------- + +* Fix a bug where calling the configure method on a +Getopt::Long::Parser object would bail out with +Undefined subroutine &Getopt::Long::Parser::Configure called at +Getopt/Long.pm line 186. + +Changes in version 2.30 +----------------------- + +* Fix a problem where a 'die' from a 'warn' via a localized + $SIG{__WARN__} was not properly propagated from a callback. + Thanks to Diab Jerius . + Changes in version 2.29 ----------------------- @@ -78,17 +156,6 @@ Changes in version 2.26 * Remove $VERSION_STRING for production versions. -Changes in version 2.26 ------------------------ - -* New option type: 'o'. It accepts all kinds of integral numbers in - Perl style, including decimal (24), octal (012), hexadecimal (0x2f) - and binary (0b1001). - -* Fix problem with getopt_compat not matching +foo=bar. - -* Remove $VERSION_STRING for production versions. - Changes in version 2.25 ----------------------- diff --git a/lib/Getopt/Long/README b/lib/Getopt/Long/README index 7870b8b..3c85646 100644 --- a/lib/Getopt/Long/README +++ b/lib/Getopt/Long/README @@ -80,14 +80,24 @@ command line options and how they must be handled: - by entering the option name and the value in an associative array (hash) or object (if it is a blessed hash); - by calling a user-specified subroutine with the option name and - the value as arguments; + the value as arguments (for hash options: the name, key and value); - combinations of the above. * Customization: -The module contains a special method, Getopt::Long::Configure, to -control configuration variables to activate (or de-activate) specific -behavior. It can be called with one or more names of options: +The module can be customized by specifying settings in the 'use' +directive, or by calling a special method, Getopt::Long::Configure. +For example, the following two cases are functionally equal: + + use Getopt::Long qw(:config bundling no_ignore_case); + +and + + use Getopt::Long; + Getopt::Long::Configure qw(bundling no_ignore_case); + +Some of the possible customizations. Most of them take a "no_" prefix +to reverse the effect: - default diff --git a/lib/Getopt/Long/t/gol-basic.t b/lib/Getopt/Long/t/gol-basic.t index c5d857d..f1916b2 100644 --- a/lib/Getopt/Long/t/gol-basic.t +++ b/lib/Getopt/Long/t/gol-basic.t @@ -1,14 +1,16 @@ #!./perl -w BEGIN { - chdir('t') if -d 't'; - @INC = '../lib'; + if ($ENV{PERL_CORE}) { + @INC = '../lib'; + chdir 't'; + } } use Getopt::Long qw(:config no_ignore_case); -die("Getopt::Long version 2.24 required--this is only version ". +die("Getopt::Long version 2.23_03 required--this is only version ". $Getopt::Long::VERSION) - unless $Getopt::Long::VERSION >= 2.24; + unless $Getopt::Long::VERSION ge "2.24"; print "1..9\n"; diff --git a/lib/Getopt/Long/t/gol-compat.t b/lib/Getopt/Long/t/gol-compat.t index 0bbe386..e211eea 100644 --- a/lib/Getopt/Long/t/gol-compat.t +++ b/lib/Getopt/Long/t/gol-compat.t @@ -1,8 +1,10 @@ #!./perl -w BEGIN { - chdir('t') if -d 't'; - @INC = '../lib'; + if ($ENV{PERL_CORE}) { + @INC = '../lib'; + chdir 't'; + } } require "newgetopt.pl"; diff --git a/lib/Getopt/Long/t/gol-linkage.t b/lib/Getopt/Long/t/gol-linkage.t index 3bd81a3..a3047cf 100644 --- a/lib/Getopt/Long/t/gol-linkage.t +++ b/lib/Getopt/Long/t/gol-linkage.t @@ -1,8 +1,10 @@ #!./perl -w BEGIN { - chdir('t') if -d 't'; - @INC = '../lib'; + if ($ENV{PERL_CORE}) { + @INC = '../lib'; + chdir 't'; + } } use Getopt::Long; diff --git a/lib/Getopt/Long/t/gol-oo.t b/lib/Getopt/Long/t/gol-oo.t index 98f3eaa..f8191d1 100644 --- a/lib/Getopt/Long/t/gol-oo.t +++ b/lib/Getopt/Long/t/gol-oo.t @@ -1,14 +1,16 @@ #!./perl -w BEGIN { - chdir('t') if -d 't'; - @INC = '../lib'; + if ($ENV{PERL_CORE}) { + @INC = '../lib'; + chdir 't'; + } } use Getopt::Long; -die("Getopt::Long version 2.24 required--this is only version ". +die("Getopt::Long version 2.23_03 required--this is only version ". $Getopt::Long::VERSION) - unless $Getopt::Long::VERSION >= 2.24; + unless $Getopt::Long::VERSION ge "2.24"; print "1..9\n"; @ARGV = qw(-Foo -baR --foo bar);