1N/A#!./perl
1N/A
1N/A#
1N/A# test glob() in File::DosGlob
1N/A#
1N/A
1N/ABEGIN {
1N/A chdir 't' if -d 't';
1N/A @INC = '../lib';
1N/A}
1N/A
1N/Aprint "1..10\n";
1N/A
1N/A# override it in main::
1N/Ause File::DosGlob 'glob';
1N/A
1N/A# test if $_ takes as the default
1N/Amy $expected;
1N/Aif ($^O eq 'MacOS') {
1N/A $expected = $_ = ":op:a*.t";
1N/A} else {
1N/A $expected = $_ = "op/a*.t";
1N/A}
1N/Amy @r = glob;
1N/Aprint "not " if $_ ne $expected;
1N/Aprint "ok 1\n";
1N/Aprint "# |@r|\nnot " if @r < 9;
1N/Aprint "ok 2\n";
1N/A
1N/A# check if <*/*> works
1N/Aif ($^O eq 'MacOS') {
1N/A @r = <:*:a*.t>;
1N/A} else {
1N/A @r = <*/a*.t>;
1N/A}
1N/A# atleast {argv,abbrev,anydbm,autoloader,append,arith,array,assignwarn,auto}.t
1N/Aprint "# |@r|\nnot " if @r < 9;
1N/Aprint "ok 3\n";
1N/Amy $r = scalar @r;
1N/A
1N/A# check if scalar context works
1N/A@r = ();
1N/Awhile (defined($_ = ($^O eq 'MacOS') ? <:*:a*.t> : <*/a*.t>)) {
1N/A print "# $_\n";
1N/A push @r, $_;
1N/A}
1N/Aprint "not " if @r != $r;
1N/Aprint "ok 4\n";
1N/A
1N/A# check if list context works
1N/A@r = ();
1N/Aif ($^O eq 'MacOS') {
1N/A for (<:*:a*.t>) {
1N/A print "# $_\n";
1N/A push @r, $_;
1N/A }
1N/A} else {
1N/A for (<*/a*.t>) {
1N/A print "# $_\n";
1N/A push @r, $_;
1N/A }
1N/A}
1N/Aprint "not " if @r != $r;
1N/Aprint "ok 5\n";
1N/A
1N/A# test if implicit assign to $_ in while() works
1N/A@r = ();
1N/Aif ($^O eq 'MacOS') {
1N/A while (<:*:a*.t>) {
1N/A print "# $_\n";
1N/A push @r, $_;
1N/A }
1N/A} else {
1N/A while (<*/a*.t>) {
1N/A print "# $_\n";
1N/A push @r, $_;
1N/A }
1N/A}
1N/Aprint "not " if @r != $r;
1N/Aprint "ok 6\n";
1N/A
1N/A# test if explicit glob() gets assign magic too
1N/Amy @s = ();
1N/Amy $pat = ($^O eq 'MacOS') ? ':*:a*.t': '*/a*.t';
1N/Awhile (glob ($pat)) {
1N/A print "# $_\n";
1N/A push @s, $_;
1N/A}
1N/Aprint "not " if "@r" ne "@s";
1N/Aprint "ok 7\n";
1N/A
1N/A# how about in a different package, like?
1N/Apackage Foo;
1N/Ause File::DosGlob 'glob';
1N/A@s = ();
1N/A$pat = $^O eq 'MacOS' ? ':*:a*.t' : '*/a*.t';
1N/Awhile (glob($pat)) {
1N/A print "# $_\n";
1N/A push @s, $_;
1N/A}
1N/Aprint "not " if "@r" ne "@s";
1N/Aprint "ok 8\n";
1N/A
1N/A# test if different glob ops maintain independent contexts
1N/A@s = ();
1N/Aif ($^O eq 'MacOS') {
1N/A while (<:*:a*.t>) {
1N/A my $i = 0;
1N/A print "# $_ <";
1N/A push @s, $_;
1N/A while (<:*:b*.t>) {
1N/A print " $_";
1N/A $i++;
1N/A }
1N/A print " >\n";
1N/A }
1N/A} else {
1N/A while (<*/a*.t>) {
1N/A my $i = 0;
1N/A print "# $_ <";
1N/A push @s, $_;
1N/A while (<*/b*.t>) {
1N/A print " $_";
1N/A $i++;
1N/A }
1N/A print " >\n";
1N/A }
1N/A}
1N/Aprint "not " if "@r" ne "@s";
1N/Aprint "ok 9\n";
1N/A
1N/A# how about a global override, hm?
1N/Aeval <<'EOT';
1N/Ause File::DosGlob 'GLOBAL_glob';
1N/Apackage Bar;
1N/A@s = ();
1N/Aif ($^O eq 'MacOS') {
1N/A while (<:*:a*.t>) {
1N/A my $i = 0;
1N/A print "# $_ <";
1N/A push @s, $_;
1N/A while (glob ':*:b*.t') {
1N/A print " $_";
1N/A $i++;
1N/A }
1N/A print " >\n";
1N/A }
1N/A} else {
1N/A while (<*/a*.t>) {
1N/A my $i = 0;
1N/A print "# $_ <";
1N/A push @s, $_;
1N/A while (glob '*/b*.t') {
1N/A print " $_";
1N/A $i++;
1N/A }
1N/A print " >\n";
1N/A }
1N/A}
1N/Aprint "not " if "@r" ne "@s";
1N/Aprint "ok 10\n";
1N/AEOT