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 | |
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 | ||
91e74348 | 42 | # check if list context works |
fb73857a | 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 GS |
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 |