1#!./perl 2 3# 4# test glob() in File::DosGlob 5# 6 7BEGIN { 8 chdir 't' if -d 't'; 9 @INC = '../lib'; 10} 11 12print "1..10\n"; 13 14# override it in main:: 15use File::DosGlob 'glob'; 16 17# test if $_ takes as the default 18my $expected; 19if ($^O eq 'MacOS') { 20 $expected = $_ = ":op:a*.t"; 21} else { 22 $expected = $_ = "op/a*.t"; 23} 24my @r = glob; 25print "not " if $_ ne $expected; 26print "ok 1\n"; 27print "# |@r|\nnot " if @r < 9; 28print "ok 2\n"; 29 30# check if <*/*> works 31if ($^O eq 'MacOS') { 32 @r = <:*:a*.t>; 33} else { 34 @r = <*/a*.t>; 35} 36# atleast {argv,abbrev,anydbm,autoloader,append,arith,array,assignwarn,auto}.t 37print "# |@r|\nnot " if @r < 9; 38print "ok 3\n"; 39my $r = scalar @r; 40 41# check if scalar context works 42@r = (); 43while (defined($_ = ($^O eq 'MacOS') ? <:*:a*.t> : <*/a*.t>)) { 44 print "# $_\n"; 45 push @r, $_; 46} 47print "not " if @r != $r; 48print "ok 4\n"; 49 50# check if list context works 51@r = (); 52if ($^O eq 'MacOS') { 53 for (<:*:a*.t>) { 54 print "# $_\n"; 55 push @r, $_; 56 } 57} else { 58 for (<*/a*.t>) { 59 print "# $_\n"; 60 push @r, $_; 61 } 62} 63print "not " if @r != $r; 64print "ok 5\n"; 65 66# test if implicit assign to $_ in while() works 67@r = (); 68if ($^O eq 'MacOS') { 69 while (<:*:a*.t>) { 70 print "# $_\n"; 71 push @r, $_; 72 } 73} else { 74 while (<*/a*.t>) { 75 print "# $_\n"; 76 push @r, $_; 77 } 78} 79print "not " if @r != $r; 80print "ok 6\n"; 81 82# test if explicit glob() gets assign magic too 83my @s = (); 84my $pat = ($^O eq 'MacOS') ? ':*:a*.t': '*/a*.t'; 85while (glob ($pat)) { 86 print "# $_\n"; 87 push @s, $_; 88} 89print "not " if "@r" ne "@s"; 90print "ok 7\n"; 91 92# how about in a different package, like? 93package Foo; 94use File::DosGlob 'glob'; 95@s = (); 96$pat = $^O eq 'MacOS' ? ':*:a*.t' : '*/a*.t'; 97while (glob($pat)) { 98 print "# $_\n"; 99 push @s, $_; 100} 101print "not " if "@r" ne "@s"; 102print "ok 8\n"; 103 104# test if different glob ops maintain independent contexts 105@s = (); 106if ($^O eq 'MacOS') { 107 while (<:*:a*.t>) { 108 my $i = 0; 109 print "# $_ <"; 110 push @s, $_; 111 while (<:*:b*.t>) { 112 print " $_"; 113 $i++; 114 } 115 print " >\n"; 116 } 117} else { 118 while (<*/a*.t>) { 119 my $i = 0; 120 print "# $_ <"; 121 push @s, $_; 122 while (<*/b*.t>) { 123 print " $_"; 124 $i++; 125 } 126 print " >\n"; 127 } 128} 129print "not " if "@r" ne "@s"; 130print "ok 9\n"; 131 132# how about a global override, hm? 133eval <<'EOT'; 134use File::DosGlob 'GLOBAL_glob'; 135package Bar; 136@s = (); 137if ($^O eq 'MacOS') { 138 while (<:*:a*.t>) { 139 my $i = 0; 140 print "# $_ <"; 141 push @s, $_; 142 while (glob ':*:b*.t') { 143 print " $_"; 144 $i++; 145 } 146 print " >\n"; 147 } 148} else { 149 while (<*/a*.t>) { 150 my $i = 0; 151 print "# $_ <"; 152 push @s, $_; 153 while (glob '*/b*.t') { 154 print " $_"; 155 $i++; 156 } 157 print " >\n"; 158 } 159} 160print "not " if "@r" ne "@s"; 161print "ok 10\n"; 162EOT 163