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