1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6 require Config; import Config; 7 if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) { 8 print "1..0\n"; 9 exit 0; 10 } 11} 12 13use Test::More tests => 11; 14 15BEGIN { 16 *CORE::GLOBAL::glob = sub { "Just another Perl hacker," }; 17} 18 19BEGIN { 20 if ("Just another Perl hacker," ne (<*>)[0]) { 21 die <<EOMessage; 22Your version of perl ($]) doesn't seem to allow extensions to override 23the core glob operator. 24EOMessage 25 } 26} 27 28BEGIN { 29 use_ok('File::Glob', ':globally'); 30} 31 32$_ = "op/*.t"; 33my @r = glob; 34is($_, "op/*.t"); 35 36cmp_ok(scalar @r, '>=', 3); 37 38@r = <*/*.t>; 39# at least t/global.t t/basic.t, t/taint.t 40cmp_ok(scalar @r, '>=', 3, 'check if <*/*> works'); 41my $r = scalar @r; 42 43@r = (); 44while (defined($_ = <*/*.t>)) { 45 #print "# $_\n"; 46 push @r, $_; 47} 48is(scalar @r, $r, 'check if scalar context works'); 49 50@r = (); 51for (<*/*.t>) { 52 #print "# $_\n"; 53 push @r, $_; 54} 55is(scalar @r, $r, 'check if list context works'); 56 57@r = (); 58while (<*/*.t>) { 59 #print "# $_\n"; 60 push @r, $_; 61} 62is(scalar @r, $r, 'implicit assign to $_ in while()'); 63 64my @s = (); 65while (glob('*/*.t')) { 66 #print "# $_\n"; 67 push @s, $_; 68} 69is("@r", "@s", 'explicit glob() gets assign magic too'); 70 71package Foo; 72use File::Glob ':globally'; 73@s = (); 74while (glob('*/*.t')) { 75 #print "# $_\n"; 76 push @s, $_; 77} 78main::is("@r", "@s", 'in a different package'); 79 80# test if different glob ops maintain independent contexts 81@s = (); 82my $i = 0; 83while (<*/*.t>) { 84 #print "# $_ <"; 85 push @s, $_; 86 while (<bas*/*.t>) { 87 #print " $_"; 88 $i++; 89 } 90 #print " >\n"; 91} 92 93main::is("@r", "@s", 'different glob ops maintain independent contexts'); 94main::isnt($i, 0, 'different glob ops maintain independent contexts'); 95