1#!./perl -w 2 3no strict; 4 5BEGIN { 6 if ($ENV{PERL_CORE}) { 7 @INC = '../lib'; 8 chdir 't'; 9 } 10} 11 12use Getopt::Long qw(:config no_ignore_case); 13my $want_version="2.24"; 14die("Getopt::Long version $want_version required--this is only version ". 15 $Getopt::Long::VERSION) 16 unless $Getopt::Long::VERSION ge $want_version; 17 18print "1..18\n"; 19 20@ARGV = qw(-Foo -baR --foo bar); 21undef $opt_baR; 22undef $opt_bar; 23print (GetOptions("foo", "Foo=s") ? "" : "not ", "ok 1\n"); 24print ((defined $opt_foo) ? "" : "not ", "ok 2\n"); 25print (($opt_foo == 1) ? "" : "not ", "ok 3\n"); 26print ((defined $opt_Foo) ? "" : "not ", "ok 4\n"); 27print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n"); 28print ((@ARGV == 1) ? "" : "not ", "ok 6\n"); 29print (($ARGV[0] eq "bar") ? "" : "not ", "ok 7\n"); 30print (!(defined $opt_baR) ? "" : "not ", "ok 8\n"); 31print (!(defined $opt_bar) ? "" : "not ", "ok 9\n"); 32 33# Tests added, see https://rt.cpan.org/Ticket/Display.html?id=87581 34@ARGV = qw(--help --file foo --foo --nobar --num=5 -- file); 35$rv = GetOptions( 36 'help' => \$HELP, 37 'file:s' => \$FILE, 38 'foo!' => \$FOO, 39 'bar!' => \$BAR, 40 'num:i' => \$NO, 41 ); 42print ($rv ? "" : "not "); print "ok 10\n"; 43print ("@ARGV" eq 'file' ? "" : "not ", "ok 11\n"); 44( $HELP && $FOO && !$BAR && $FILE eq 'foo' && $NO == 5 ) 45 ? print "" : print "not "; print "ok 12\n"; 46 47# Test behaviour when the same option name is given twice, but not an multi-value option. 48# The option given later on the command line is used. 49# 50{ 51 my $foo; 52 53 @ARGV = qw(--foo a --foo b); 54 $rd = GetOptions('foo=s' => \$foo); 55 print ($rv ? "" : "not "); print "ok 13\n"; 56 print ($foo eq 'b' ? "" : "not ", "ok 14\n"); 57 58 @ARGV = qw(--no-foo --foo); 59 $rd = GetOptions('foo!' => \$foo); 60 print ($rv ? "" : "not "); print "ok 15\n"; 61 print ($foo eq '1' ? "" : "not ", "ok 16\n"); 62 63 @ARGV = qw(--foo --no-foo); 64 $rd = GetOptions('foo!' => \$foo); 65 print ($rv ? "" : "not "); print "ok 17\n"; 66 # Check it is set to an explicit 0. 67 print ($foo eq '0' ? "" : "not ", "ok 18\n"); 68} 69