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 | ||
dd2d1456 | 12 | use Test::More tests => 20; |
fb73857a | 13 | |
14 | # override it in main:: | |
15 | use File::DosGlob 'glob'; | |
16 | ||
2f3c8ce9 AD |
17 | require Cwd; |
18 | ||
be708cc0 | 19 | my $expected; |
7d38af62 | 20 | $expected = $_ = "op/a*.t"; |
fb73857a | 21 | my @r = glob; |
dd2d1456 NC |
22 | is ($_, $expected, 'test if $_ takes as the default'); |
23 | cmp_ok(@r, '>=', 9) or diag("|@r|"); | |
fb73857a | 24 | |
7d38af62 | 25 | @r = <*/a*.t>; |
fb73857a | 26 | # atleast {argv,abbrev,anydbm,autoloader,append,arith,array,assignwarn,auto}.t |
dd2d1456 | 27 | cmp_ok(@r, '>=', 9, 'check <*/*>') or diag("|@r|"); |
fb73857a | 28 | my $r = scalar @r; |
29 | ||
fb73857a | 30 | @r = (); |
7d38af62 | 31 | while (defined($_ = <*/a*.t>)) { |
fb73857a | 32 | print "# $_\n"; |
33 | push @r, $_; | |
34 | } | |
dd2d1456 | 35 | is(scalar @r, $r, 'check scalar context'); |
fb73857a | 36 | |
fb73857a | 37 | @r = (); |
7d38af62 NC |
38 | for (<*/a*.t>) { |
39 | print "# $_\n"; | |
40 | push @r, $_; | |
fb73857a | 41 | } |
dd2d1456 | 42 | is(scalar @r, $r, 'check list context'); |
fb73857a | 43 | |
fb73857a | 44 | @r = (); |
7d38af62 NC |
45 | while (<*/a*.t>) { |
46 | print "# $_\n"; | |
47 | push @r, $_; | |
fb73857a | 48 | } |
dd2d1456 | 49 | is(scalar @r, $r, 'implicit assign to $_ in while()'); |
fb73857a | 50 | |
fb73857a | 51 | my @s = (); |
7d38af62 | 52 | my $pat = '*/a*.t'; |
be708cc0 | 53 | while (glob ($pat)) { |
fb73857a | 54 | print "# $_\n"; |
55 | push @s, $_; | |
56 | } | |
dd2d1456 | 57 | is("@r", "@s", 'explicit glob() gets assign magic too'); |
fb73857a | 58 | |
fb73857a | 59 | package Foo; |
60 | use File::DosGlob 'glob'; | |
dd2d1456 | 61 | use Test::More; |
fb73857a | 62 | @s = (); |
7d38af62 | 63 | $pat = '*/a*.t'; |
d5201bd2 | 64 | while (glob($pat)) { |
fb73857a | 65 | print "# $_\n"; |
66 | push @s, $_; | |
67 | } | |
dd2d1456 | 68 | is("@r", "@s", 'in a different package'); |
fb73857a | 69 | |
fb73857a | 70 | @s = (); |
7d38af62 NC |
71 | while (<*/a*.t>) { |
72 | my $i = 0; | |
73 | print "# $_ <"; | |
74 | push @s, $_; | |
75 | while (<*/b*.t>) { | |
76 | print " $_"; | |
77 | $i++; | |
fb73857a | 78 | } |
7d38af62 | 79 | print " >\n"; |
fb73857a | 80 | } |
dd2d1456 | 81 | is("@r", "@s", 'different glob ops maintain independent contexts'); |
fb73857a | 82 | |
dd2d1456 | 83 | @s = (); |
95d94a4f GS |
84 | eval <<'EOT'; |
85 | use File::DosGlob 'GLOBAL_glob'; | |
86 | package Bar; | |
7d38af62 NC |
87 | while (<*/a*.t>) { |
88 | my $i = 0; | |
89 | print "# $_ <"; | |
90 | push @s, $_; | |
91 | while (glob '*/b*.t') { | |
92 | print " $_"; | |
93 | $i++; | |
95d94a4f | 94 | } |
7d38af62 | 95 | print " >\n"; |
95d94a4f | 96 | } |
95d94a4f | 97 | EOT |
dd2d1456 | 98 | is("@r", "@s", 'global override'); |
2f3c8ce9 AD |
99 | |
100 | # Test that a glob pattern containing ()'s works. | |
83f61a2e | 101 | # NB. The spaces in the glob patterns need to be backslash escaped. |
2f3c8ce9 | 102 | my $filename_containing_parens = "foo (123) bar"; |
dd2d1456 | 103 | SKIP: { |
723bc154 | 104 | skip("can't create '$filename_containing_parens': $!", 9) |
dd2d1456 NC |
105 | unless open my $touch, ">", $filename_containing_parens; |
106 | close $touch; | |
107 | ||
108 | foreach my $pattern ("foo\\ (*", "*)\\ bar", "foo\\ (1*3)\\ bar") { | |
109 | @r = (); | |
110 | eval { @r = File::DosGlob::glob($pattern) }; | |
111 | is($@, "", "eval for glob($pattern)"); | |
112 | is(scalar @r, 1); | |
113 | is($r[0], $filename_containing_parens); | |
114 | } | |
2f3c8ce9 | 115 | |
83f61a2e CB |
116 | 1 while unlink $filename_containing_parens; |
117 | } | |
2f3c8ce9 AD |
118 | |
119 | # Test the globbing of a drive relative pattern such as "c:*.pl". | |
120 | # NB. previous versions of DosGlob inserted "./ after the drive letter to | |
121 | # make the expansion process work correctly. However, while it is harmless, | |
122 | # there is no reason for it to be in the result. | |
123 | my $cwd = Cwd::cwd(); | |
124 | if ($cwd =~ /^([a-zA-Z]:)/) { | |
125 | my $drive = $1; | |
126 | @r = (); | |
127 | # This assumes we're in the "t" directory. | |
128 | eval { @r = File::DosGlob::glob("${drive}io/*.t") }; | |
dd2d1456 | 129 | ok(@r and !grep !m|^${drive}io/[^/]*\.t$|, @r); |
2f3c8ce9 | 130 | } else { |
dd2d1456 | 131 | pass(); |
2f3c8ce9 | 132 | } |