This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
warnings.pm: sprintf is faster than concat
[perl5.git] / lib / Getopt / Std.t
CommitLineData
12527e6c 1#!./perl -wT
1a3850a5
GA
2
3BEGIN {
4 chdir 't' if -d 't';
20822f61 5 @INC = '../lib';
1a3850a5
GA
6}
7
12527e6c 8use strict;
243ac78f 9use Test::More tests => 22;
1a3850a5
GA
10use Getopt::Std;
11
12527e6c
RGS
12our ($warning, $opt_f, $opt_i, $opt_o, $opt_x, $opt_y, %opt);
13
1a3850a5
GA
14# First we test the getopt function
15@ARGV = qw(-xo -f foo -y file);
16getopt('f');
17
12527e6c
RGS
18is( "@ARGV", 'file', 'options removed from @ARGV (1)' );
19ok( $opt_x && $opt_o && $opt_y, 'options -x, -o and -y set' );
20is( $opt_f, 'foo', q/option -f is 'foo'/ );
1a3850a5 21
12527e6c
RGS
22@ARGV = qw(-hij k -- -l m -n);
23getopt 'il', \%opt;
1a3850a5 24
12527e6c
RGS
25is( "@ARGV", 'k -- -l m -n', 'options removed from @ARGV (2)' );
26ok( $opt{h} && $opt{i} eq 'j', 'option -h and -i correctly set' );
27ok( !defined $opt{l}, 'option -l not set' );
28ok( !defined $opt_i, '$opt_i still undefined' );
1a3850a5
GA
29
30# Then we try the getopts
31$opt_o = $opt_i = $opt_f = undef;
32@ARGV = qw(-foi -i file);
1a3850a5 33
12527e6c
RGS
34ok( getopts('oif:'), 'getopts succeeded (1)' );
35is( "@ARGV", 'file', 'options removed from @ARGV (3)' );
36ok( $opt_i && $opt_f eq 'oi', 'options -i and -f correctly set' );
37ok( !defined $opt_o, 'option -o not set' );
1a3850a5 38
12527e6c
RGS
39%opt = (); $opt_i = undef;
40@ARGV = qw(-hij -k -- -l m);
1a3850a5 41
12527e6c
RGS
42ok( getopts('hi:kl', \%opt), 'getopts succeeded (2)' );
43is( "@ARGV", '-l m', 'options removed from @ARGV (4)' );
44ok( $opt{h} && $opt{k}, 'options -h and -k set' );
45is( $opt{i}, 'j', q/option -i is 'j'/ );
46ok( !defined $opt_i, '$opt_i still undefined' );
1a3850a5
GA
47
48# Try illegal options, but avoid printing of the error message
12527e6c 49$SIG{__WARN__} = sub { $warning = $_[0] };
1a3850a5
GA
50@ARGV = qw(-h help);
51
12527e6c
RGS
52ok( !getopts("xf:y"), 'getopts fails for an illegal option' );
53ok( $warning eq "Unknown option: h\n", 'user warned' );
1a3850a5 54
243ac78f
JK
55# Tests for RT #41359
56undef %opt;
57my $expected;
58{
59 local @ARGV = ( '-a', '-b', 'foo', '-c' );
60 getopts('ab:c:', \%opt);
61 $expected = { 'a' => 1, 'b' => 'foo', 'c' => undef };
62 is_deeply(\%opt, $expected,
63 "getopts: multiple switches; switch expected argument, none provided; value undef");
64 undef %opt;
65}
1a3850a5 66
243ac78f
JK
67{
68 local @ARGV = ( '-c' );
69 getopts('c:', \%opt);
70 $expected = { 'c' => undef };
71 is_deeply(\%opt, $expected,
72 "getopts: single switch; switch expected argument, none provided; value undef");
73 undef %opt;
74}
1a3850a5 75
243ac78f
JK
76{
77 local @ARGV = ( '-b', 'foo', '-c' );
78 getopt('bc', \%opt);
79 $expected = { 'b' => 'foo', 'c' => undef };
80 is_deeply(\%opt, $expected,
81 "getopt: multiple switches; switch expected argument, none provided; value undef");
82 undef %opt;
83}
12527e6c 84
243ac78f
JK
85{
86 local @ARGV = ( '-c' );
87 getopt('c', \%opt);
88 $expected = { 'c' => undef };
89 is_deeply(\%opt, $expected,
90 "getopt: single switch; switch expected argument, none provided; value undef");
91 undef %opt;
92}