| 1 | #!./perl -wT
|
|---|
| 2 |
|
|---|
| 3 | BEGIN {
|
|---|
| 4 | chdir 't' if -d 't';
|
|---|
| 5 | @INC = '../lib';
|
|---|
| 6 | }
|
|---|
| 7 |
|
|---|
| 8 | use strict;
|
|---|
| 9 | use Test::More tests => 21;
|
|---|
| 10 | use Getopt::Std;
|
|---|
| 11 |
|
|---|
| 12 | our ($warning, $opt_f, $opt_i, $opt_o, $opt_x, $opt_y, %opt);
|
|---|
| 13 |
|
|---|
| 14 | # First we test the getopt function
|
|---|
| 15 | @ARGV = qw(-xo -f foo -y file);
|
|---|
| 16 | getopt('f');
|
|---|
| 17 |
|
|---|
| 18 | is( "@ARGV", 'file', 'options removed from @ARGV (1)' );
|
|---|
| 19 | ok( $opt_x && $opt_o && $opt_y, 'options -x, -o and -y set' );
|
|---|
| 20 | is( $opt_f, 'foo', q/option -f is 'foo'/ );
|
|---|
| 21 |
|
|---|
| 22 | @ARGV = qw(-hij k -- -l m -n);
|
|---|
| 23 | getopt 'il', \%opt;
|
|---|
| 24 |
|
|---|
| 25 | is( "@ARGV", 'k -- -l m -n', 'options removed from @ARGV (2)' );
|
|---|
| 26 | ok( $opt{h} && $opt{i} eq 'j', 'option -h and -i correctly set' );
|
|---|
| 27 | ok( !defined $opt{l}, 'option -l not set' );
|
|---|
| 28 | ok( !defined $opt_i, '$opt_i still undefined' );
|
|---|
| 29 |
|
|---|
| 30 | # Then we try the getopts
|
|---|
| 31 | $opt_o = $opt_i = $opt_f = undef;
|
|---|
| 32 | @ARGV = qw(-foi -i file);
|
|---|
| 33 |
|
|---|
| 34 | ok( getopts('oif:'), 'getopts succeeded (1)' );
|
|---|
| 35 | is( "@ARGV", 'file', 'options removed from @ARGV (3)' );
|
|---|
| 36 | ok( $opt_i && $opt_f eq 'oi', 'options -i and -f correctly set' );
|
|---|
| 37 | ok( !defined $opt_o, 'option -o not set' );
|
|---|
| 38 |
|
|---|
| 39 | %opt = (); $opt_i = undef;
|
|---|
| 40 | @ARGV = qw(-hij -k -- -l m);
|
|---|
| 41 |
|
|---|
| 42 | ok( getopts('hi:kl', \%opt), 'getopts succeeded (2)' );
|
|---|
| 43 | is( "@ARGV", '-l m', 'options removed from @ARGV (4)' );
|
|---|
| 44 | ok( $opt{h} && $opt{k}, 'options -h and -k set' );
|
|---|
| 45 | is( $opt{i}, 'j', q/option -i is 'j'/ );
|
|---|
| 46 | ok( !defined $opt_i, '$opt_i still undefined' );
|
|---|
| 47 |
|
|---|
| 48 | # Try illegal options, but avoid printing of the error message
|
|---|
| 49 | $SIG{__WARN__} = sub { $warning = $_[0] };
|
|---|
| 50 | @ARGV = qw(-h help);
|
|---|
| 51 |
|
|---|
| 52 | ok( !getopts("xf:y"), 'getopts fails for an illegal option' );
|
|---|
| 53 | ok( $warning eq "Unknown option: h\n", 'user warned' );
|
|---|
| 54 |
|
|---|
| 55 | # Then try the Getopt::Long module
|
|---|
| 56 |
|
|---|
| 57 | use Getopt::Long;
|
|---|
| 58 |
|
|---|
| 59 | @ARGV = qw(--help --file foo --foo --nobar --num=5 -- file);
|
|---|
| 60 |
|
|---|
| 61 | our ($HELP, $FILE, $FOO, $BAR, $NO);
|
|---|
| 62 |
|
|---|
| 63 | ok( GetOptions(
|
|---|
| 64 | 'help' => \$HELP,
|
|---|
| 65 | 'file:s' => \$FILE,
|
|---|
| 66 | 'foo!' => \$FOO,
|
|---|
| 67 | 'bar!' => \$BAR,
|
|---|
| 68 | 'num:i' => \$NO,
|
|---|
| 69 | ),
|
|---|
| 70 | 'Getopt::Long::GetOptions succeeded'
|
|---|
| 71 | );
|
|---|
| 72 | is( "@ARGV", 'file', 'options removed from @ARGV (5)' );
|
|---|
| 73 | ok( $HELP && $FOO && !$BAR && $FILE eq 'foo' && $NO == 5, 'options set' );
|
|---|