1b39c5158Smillert#!./perl -w 2b39c5158Smillert 3b39c5158Smillertno strict; 4b39c5158Smillert 5b39c5158SmillertBEGIN { 6b39c5158Smillert if ($ENV{PERL_CORE}) { 7b39c5158Smillert @INC = '../lib'; 8b39c5158Smillert chdir 't'; 9b39c5158Smillert } 10b39c5158Smillert} 11b39c5158Smillert 12b39c5158Smillertuse Getopt::Long qw(:config no_ignore_case); 13b39c5158Smillertmy $want_version="2.24"; 14b39c5158Smillertdie("Getopt::Long version $want_version required--this is only version ". 15b39c5158Smillert $Getopt::Long::VERSION) 16b39c5158Smillert unless $Getopt::Long::VERSION ge $want_version; 17b39c5158Smillert 18*f2a19305Safresh1print "1..18\n"; 19b39c5158Smillert 20b39c5158Smillert@ARGV = qw(-Foo -baR --foo bar); 21b39c5158Smillertundef $opt_baR; 22b39c5158Smillertundef $opt_bar; 23b39c5158Smillertprint (GetOptions("foo", "Foo=s") ? "" : "not ", "ok 1\n"); 24b39c5158Smillertprint ((defined $opt_foo) ? "" : "not ", "ok 2\n"); 25b39c5158Smillertprint (($opt_foo == 1) ? "" : "not ", "ok 3\n"); 26b39c5158Smillertprint ((defined $opt_Foo) ? "" : "not ", "ok 4\n"); 27b39c5158Smillertprint (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n"); 28b39c5158Smillertprint ((@ARGV == 1) ? "" : "not ", "ok 6\n"); 29b39c5158Smillertprint (($ARGV[0] eq "bar") ? "" : "not ", "ok 7\n"); 30b39c5158Smillertprint (!(defined $opt_baR) ? "" : "not ", "ok 8\n"); 31b39c5158Smillertprint (!(defined $opt_bar) ? "" : "not ", "ok 9\n"); 32256a93a4Safresh1 33256a93a4Safresh1# Tests added, see https://rt.cpan.org/Ticket/Display.html?id=87581 34256a93a4Safresh1@ARGV = qw(--help --file foo --foo --nobar --num=5 -- file); 35256a93a4Safresh1$rv = GetOptions( 36256a93a4Safresh1 'help' => \$HELP, 37256a93a4Safresh1 'file:s' => \$FILE, 38256a93a4Safresh1 'foo!' => \$FOO, 39256a93a4Safresh1 'bar!' => \$BAR, 40256a93a4Safresh1 'num:i' => \$NO, 41256a93a4Safresh1 ); 42256a93a4Safresh1print ($rv ? "" : "not "); print "ok 10\n"; 43256a93a4Safresh1print ("@ARGV" eq 'file' ? "" : "not ", "ok 11\n"); 44256a93a4Safresh1( $HELP && $FOO && !$BAR && $FILE eq 'foo' && $NO == 5 ) 45256a93a4Safresh1 ? print "" : print "not "; print "ok 12\n"; 46*f2a19305Safresh1 47*f2a19305Safresh1# Test behaviour when the same option name is given twice, but not an multi-value option. 48*f2a19305Safresh1# The option given later on the command line is used. 49*f2a19305Safresh1# 50*f2a19305Safresh1{ 51*f2a19305Safresh1 my $foo; 52*f2a19305Safresh1 53*f2a19305Safresh1 @ARGV = qw(--foo a --foo b); 54*f2a19305Safresh1 $rd = GetOptions('foo=s' => \$foo); 55*f2a19305Safresh1 print ($rv ? "" : "not "); print "ok 13\n"; 56*f2a19305Safresh1 print ($foo eq 'b' ? "" : "not ", "ok 14\n"); 57*f2a19305Safresh1 58*f2a19305Safresh1 @ARGV = qw(--no-foo --foo); 59*f2a19305Safresh1 $rd = GetOptions('foo!' => \$foo); 60*f2a19305Safresh1 print ($rv ? "" : "not "); print "ok 15\n"; 61*f2a19305Safresh1 print ($foo eq '1' ? "" : "not ", "ok 16\n"); 62*f2a19305Safresh1 63*f2a19305Safresh1 @ARGV = qw(--foo --no-foo); 64*f2a19305Safresh1 $rd = GetOptions('foo!' => \$foo); 65*f2a19305Safresh1 print ($rv ? "" : "not "); print "ok 17\n"; 66*f2a19305Safresh1 # Check it is set to an explicit 0. 67*f2a19305Safresh1 print ($foo eq '0' ? "" : "not ", "ok 18\n"); 68*f2a19305Safresh1} 69