Getopt::Std cleanup

Message-Id: <20010918173213.C777@rafael>

p4raw-id: //depot/perl@12070

diff --git a/lib/Getopt/Std.pm b/lib/Getopt/Std.pm
index e5b369c..1e6413b 100644 (file)
--- a/lib/Getopt/Std.pm
+++ b/lib/Getopt/Std.pm
@@ -12,26 +12,30 @@ getopts - Process single-character switches with switch clustering
 
     use Getopt::Std;
 
-    getopt('oDI');    # -o, -D & -I take arg.  Sets opt_* as a side effect.
+    getopt('oDI');    # -o, -D & -I take arg.  Sets $opt_* as a side effect.
     getopt('oDI', \%opts);    # -o, -D & -I take arg.  Values in %opts
     getopts('oif:');  # -o & -i are boolean flags, -f takes an argument
-                     # Sets opt_* as a side effect.
+                     # Sets $opt_* as a side effect.
     getopts('oif:', \%opts);  # options as above. Values in %opts
 
 =head1 DESCRIPTION
 
-The getopt() functions processes single-character switches with switch
+The getopt() function processes single-character switches with switch
 clustering.  Pass one argument which is a string containing all switches
 that take an argument.  For each switch found, sets $opt_x (where x is the
 switch name) to the value of the argument, or 1 if no argument.  Switches
 which take an argument don't care whether there is a space between the
 switch and the argument.
 
+The getopts() function is similar, but you should pass to it the list of all
+switches to be recognized.  If unspecified switches are found on the
+command-line, the user will be warned that an unknown option was given.
+
 Note that, if your code is running under the recommended C<use strict
 'vars'> pragma, you will need to declare these package variables
 with "our":
 
-    our($opt_foo, $opt_bar);
+    our($opt_x, $opt_y);
 
 For those of you who don't like additional global variables being created, getopt()
 and getopts() will also accept a hash reference as an optional second argument. 
@@ -46,7 +50,7 @@ C<-->.  The C<--> will be removed from @ARGV.
 
 @ISA = qw(Exporter);
 @EXPORT = qw(getopt getopts);
-$VERSION = '1.02';
+$VERSION = '1.03';
 
 # Process single-character switches with switch clustering.  Pass one argument
 # which is a string containing all switches that take an argument.  For each
@@ -57,9 +61,11 @@ $VERSION = '1.02';
 # Usage:
 #      getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.
 
-sub getopt ($;$) {
-    local($argumentative, $hash) = @_;
-    local($_,$first,$rest);
+sub getopt (;$$) {
+    my ($argumentative, $hash) = @_;
+    $argumentative = '' if !defined $argumentative;
+    my ($first,$rest);
+    local $_;
     local @EXPORT;
 
     while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
@@ -111,9 +117,10 @@ sub getopt ($;$) {
 #                      #  side effect.
 
 sub getopts ($;$) {
-    local($argumentative, $hash) = @_;
-    local(@args,$_,$first,$rest);
-    local($errs) = 0;
+    my ($argumentative, $hash) = @_;
+    my (@args,$first,$rest);
+    my $errs = 0;
+    local $_;
     local @EXPORT;
 
     @args = split( / */, $argumentative );

diff --git a/lib/Getopt/Std.t b/lib/Getopt/Std.t
index fb70f10..35922ab 100755 (executable)
--- a/lib/Getopt/Std.t
+++ b/lib/Getopt/Std.t
@@ -1,52 +1,56 @@
-#!./perl
+#!./perl -wT
 
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
 }
 
-print "1..11\n";
-
+use strict;
+use Test::More tests => 21;
 use Getopt::Std;
 
+our ($warning, $opt_f, $opt_i, $opt_o, $opt_x, $opt_y, %opt);
+
 # First we test the getopt function
 @ARGV = qw(-xo -f foo -y file);
 getopt('f');
 
-print "not " if "@ARGV" ne 'file';
-print "ok 1\n";
-
-print "not " unless $opt_x && $opt_o && opt_y;
-print "ok 2\n";
+is( "@ARGV", 'file',           'options removed from @ARGV (1)' );
+ok( $opt_x && $opt_o && $opt_y, 'options -x, -o and -y set' );
+is( $opt_f, 'foo',             q/option -f is 'foo'/ );
 
-print "not " unless $opt_f eq 'foo';
-print "ok 3\n";
+@ARGV = qw(-hij k -- -l m -n);
+getopt 'il', \%opt;
 
+is( "@ARGV", 'k -- -l m -n',   'options removed from @ARGV (2)' );
+ok( $opt{h} && $opt{i} eq 'j', 'option -h and -i correctly set' );
+ok( !defined $opt{l},          'option -l not set' );
+ok( !defined $opt_i,           '$opt_i still undefined' );
 
 # Then we try the getopts
 $opt_o = $opt_i = $opt_f = undef;
 @ARGV = qw(-foi -i file);
-getopts('oif:') or print "not ";
-print "ok 4\n";
 
-print "not " unless "@ARGV" eq 'file';
-print "ok 5\n";
+ok( getopts('oif:'),           'getopts succeeded (1)' );
+is( "@ARGV", 'file',           'options removed from @ARGV (3)' );
+ok( $opt_i && $opt_f eq 'oi',  'options -i and -f correctly set' );
+ok( !defined $opt_o,           'option -o not set' );
 
-print "not " unless $opt_i and $opt_f eq 'oi';
-print "ok 6\n";
+%opt = (); $opt_i = undef;
+@ARGV = qw(-hij -k -- -l m);
 
-print "not " if $opt_o;
-print "ok 7\n";
+ok( getopts('hi:kl', \%opt),   'getopts succeeded (2)' );
+is( "@ARGV", '-l m',           'options removed from @ARGV (4)' );
+ok( $opt{h} && $opt{k},                'options -h and -k set' );
+is( $opt{i}, 'j',              q/option -i is 'j'/ );
+ok( !defined $opt_i,           '$opt_i still undefined' );
 
 # Try illegal options, but avoid printing of the error message
-
-open(STDERR, ">stderr") || die;
-
+$SIG{__WARN__} = sub { $warning = $_[0] };
 @ARGV = qw(-h help);
 
-!getopts("xf:y") or print "not ";
-print "ok 8\n";
-
+ok( !getopts("xf:y"),          'getopts fails for an illegal option' );
+ok( $warning eq "Unknown option: h\n", 'user warned' );
 
 # Then try the Getopt::Long module
 
@@ -54,20 +58,16 @@ use Getopt::Long;
 
 @ARGV = qw(--help --file foo --foo --nobar --num=5 -- file);
 
-GetOptions(
-   'help'   => \$HELP,
-   'file:s' => \$FILE,
-   'foo!'   => \$FOO,
-   'bar!'   => \$BAR,
-   'num:i'  => \$NO,
-) || print "not ";
-print "ok 9\n";
-
-print "not " unless $HELP && $FOO && !$BAR && $FILE eq 'foo' && $NO == 5;
-print "ok 10\n";
-
-print "not " unless "@ARGV" eq "file";
-print "ok 11\n";
-
-close STDERR;
-unlink "stderr";
+our ($HELP, $FILE, $FOO, $BAR, $NO);
+
+ok( GetOptions(
+       'help'   => \$HELP,
+       'file:s' => \$FILE,
+       'foo!'   => \$FOO,
+       'bar!'   => \$BAR,
+       'num:i'  => \$NO,
+    ),
+    'Getopt::Long::GetOptions succeeded'
+);
+is( "@ARGV", 'file', 'options removed from @ARGV (5)' );
+ok( $HELP && $FOO && !$BAR && $FILE eq 'foo' && $NO == 5, 'options set' );