Commit | Line | Data |
fb73857a |
1 | #!./perl |
2 | |
3 | # |
4 | # test glob() in File::DosGlob |
5 | # |
6 | |
7 | BEGIN { |
8 | chdir 't' if -d 't'; |
9 | @INC = '../lib'; |
10 | } |
11 | |
95d94a4f |
12 | print "1..10\n"; |
fb73857a |
13 | |
14 | # override it in main:: |
15 | use File::DosGlob 'glob'; |
16 | |
17 | # test if $_ takes as the default |
18 | $_ = "lib/a*.t"; |
19 | my @r = glob; |
20 | print "not " if $_ ne 'lib/a*.t'; |
21 | print "ok 1\n"; |
22 | # we should have at least abbrev.t, anydbm.t, autoloader.t |
23 | print "# |@r|\nnot " if @r < 3; |
24 | print "ok 2\n"; |
25 | |
26 | # check if <*/*> works |
27 | @r = <*/a*.t>; |
28 | # atleast {argv,abbrev,anydbm,autoloader,append,arith,array,assignwarn,auto}.t |
29 | print "not " if @r < 9; |
30 | print "ok 3\n"; |
31 | my $r = scalar @r; |
32 | |
33 | # check if scalar context works |
34 | @r = (); |
35 | while (defined($_ = <*/a*.t>)) { |
36 | print "# $_\n"; |
37 | push @r, $_; |
38 | } |
39 | print "not " if @r != $r; |
40 | print "ok 4\n"; |
41 | |
42 | # check if array context works |
43 | @r = (); |
44 | for (<*/a*.t>) { |
45 | print "# $_\n"; |
46 | push @r, $_; |
47 | } |
48 | print "not " if @r != $r; |
49 | print "ok 5\n"; |
50 | |
51 | # test if implicit assign to $_ in while() works |
52 | @r = (); |
53 | while (<*/a*.t>) { |
54 | print "# $_\n"; |
55 | push @r, $_; |
56 | } |
57 | print "not " if @r != $r; |
58 | print "ok 6\n"; |
59 | |
60 | # test if explicit glob() gets assign magic too |
61 | my @s = (); |
62 | while (glob '*/a*.t') { |
63 | print "# $_\n"; |
64 | push @s, $_; |
65 | } |
66 | print "not " if "@r" ne "@s"; |
67 | print "ok 7\n"; |
68 | |
69 | # how about in a different package, like? |
70 | package Foo; |
71 | use File::DosGlob 'glob'; |
72 | @s = (); |
73 | while (glob '*/a*.t') { |
74 | print "# $_\n"; |
75 | push @s, $_; |
76 | } |
77 | print "not " if "@r" ne "@s"; |
78 | print "ok 8\n"; |
79 | |
80 | # test if different glob ops maintain independent contexts |
81 | @s = (); |
82 | while (<*/a*.t>) { |
83 | my $i = 0; |
84 | print "# $_ <"; |
85 | push @s, $_; |
86 | while (<*/b*.t>) { |
87 | print " $_"; |
88 | $i++; |
89 | } |
90 | print " >\n"; |
91 | } |
92 | print "not " if "@r" ne "@s"; |
93 | print "ok 9\n"; |
94 | |
95d94a4f |
95 | # how about a global override, hm? |
96 | eval <<'EOT'; |
97 | use File::DosGlob 'GLOBAL_glob'; |
98 | package Bar; |
99 | @s = (); |
100 | while (<*/a*.t>) { |
101 | my $i = 0; |
102 | print "# $_ <"; |
103 | push @s, $_; |
104 | while (glob '*/b*.t') { |
105 | print " $_"; |
106 | $i++; |
107 | } |
108 | print " >\n"; |
109 | } |
110 | print "not " if "@r" ne "@s"; |
111 | print "ok 10\n"; |
112 | EOT |