1117119Stmm#!./perl -w 2117119Stmm 3117119Stmmno strict; 4117119Stmm 5117119StmmBEGIN { 6200921Smarius if ($ENV{PERL_CORE}) { 7117119Stmm @INC = '../lib'; 8117119Stmm chdir 't'; 9117119Stmm } 10117119Stmm} 11117119Stmm 12117119Stmmuse Getopt::Long qw(GetOptionsFromString :config no_ignore_case); 13117119Stmmmy $want_version="2.3501"; 14117119Stmmdie("Getopt::Long version $want_version required--this is only version ". 15117119Stmm $Getopt::Long::VERSION) 16117119Stmm unless $Getopt::Long::VERSION ge $want_version; 17117119Stmm 18117119Stmmprint "1..14\n"; 19117119Stmm 20117119Stmmmy $args = "-Foo -baR --foo"; 21117119Stmm@ARGV = qw(foo bar); 22117119Stmmundef $opt_baR; 23117119Stmmundef $opt_bar; 24117119Stmmprint (GetOptionsFromString($args, "foo", "Foo=s") ? "" : "not ", "ok 1\n"); 25117119Stmmprint ((defined $opt_foo) ? "" : "not ", "ok 2\n"); 26117119Stmmprint (($opt_foo == 1) ? "" : "not ", "ok 3\n"); 27117119Stmmprint ((defined $opt_Foo) ? "" : "not ", "ok 4\n"); 28117119Stmmprint (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n"); 29117119Stmmprint (!(defined $opt_baR) ? "" : "not ", "ok 6\n"); 30117119Stmmprint (!(defined $opt_bar) ? "" : "not ", "ok 7\n"); 31152684Smariusprint ("@ARGV" eq "foo bar" ? "" : "not ", "ok 8\n"); 32152684Smarius 33152684Smarius$args = "-Foo -baR blech --foo bar"; 34117119Stmm@ARGV = qw(foo bar); 35133589Smariusundef $opt_baR; 36117119Stmmundef $opt_bar; 37117119Stmm{ my $msg = ""; 38117119Stmm local $SIG{__WARN__} = sub { $msg .= "@_" }; 39117119Stmm my $ret = GetOptionsFromString($args, "foo", "Foo=s"); 40117119Stmm print ($ret ? "not " : "ok 9\n"); 41117119Stmm print ($msg =~ /^GetOptionsFromString: Excess data / ? "" : "$msg\nnot ", "ok 10\n"); 42117119Stmm} 43133589Smariusprint ("@ARGV" eq "foo bar" ? "" : "not ", "ok 11\n"); 44133589Smarius 45117119Stmm$args = "-Foo -baR blech --foo bar"; 46117119Stmm@ARGV = qw(foo bar); 47117119Stmmundef $opt_baR; 48178728Smariusundef $opt_bar; 49117119Stmm{ my $ret; 50169793Smarius ($ret, $args) = GetOptionsFromString($args, "foo", "Foo=s"); 51163146Skmacy print ($ret ? "" : "not ", "ok 12\n"); 52117119Stmm print ("@$args" eq "blech bar" ? "" : "@$args\nnot ", "ok 13\n"); 53117119Stmm} 54117119Stmmprint ("@ARGV" eq "foo bar" ? "" : "not ", "ok 14\n"); 55117119Stmm