Commit | Line | Data |
72b16652 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
20822f61 |
5 | @INC = '../lib'; |
d2a01882 |
6 | require Config; import Config; |
7 | if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) { |
8 | print "1..0\n"; |
9 | exit 0; |
10 | } |
72b16652 |
11 | print "1..10\n"; |
12 | } |
13 | END { |
14 | print "not ok 1\n" unless $loaded; |
15 | } |
16 | |
17 | BEGIN { |
18 | *CORE::GLOBAL::glob = sub { "Just another Perl hacker," }; |
19 | } |
20 | |
21 | BEGIN { |
22 | if ("Just another Perl hacker," ne (<*>)[0]) { |
23 | die <<EOMessage; |
24 | Your version of perl ($]) doesn't seem to allow extensions to override |
25 | the core glob operator. |
26 | EOMessage |
27 | } |
28 | } |
29 | |
220398a0 |
30 | use File::Glob ':globally'; |
72b16652 |
31 | $loaded = 1; |
32 | print "ok 1\n"; |
33 | |
34 | $_ = "lib/*.t"; |
35 | my @r = glob; |
36 | print "not " if $_ ne 'lib/*.t'; |
37 | print "ok 2\n"; |
38 | |
39 | # we should have at least basic.t, global.t, taint.t |
40 | print "# |@r|\nnot " if @r < 3; |
41 | print "ok 3\n"; |
42 | |
43 | # check if <*/*> works |
44 | @r = <*/*.t>; |
45 | # at least t/global.t t/basic.t, t/taint.t |
46 | print "not " if @r < 3; |
47 | print "ok 4\n"; |
48 | my $r = scalar @r; |
49 | |
50 | # check if scalar context works |
51 | @r = (); |
52 | while (defined($_ = <*/*.t>)) { |
53 | #print "# $_\n"; |
54 | push @r, $_; |
55 | } |
56 | print "not " if @r != $r; |
57 | print "ok 5\n"; |
58 | |
91e74348 |
59 | # check if list context works |
72b16652 |
60 | @r = (); |
61 | for (<*/*.t>) { |
62 | #print "# $_\n"; |
63 | push @r, $_; |
64 | } |
65 | print "not " if @r != $r; |
66 | print "ok 6\n"; |
67 | |
68 | # test if implicit assign to $_ in while() works |
69 | @r = (); |
70 | while (<*/*.t>) { |
71 | #print "# $_\n"; |
72 | push @r, $_; |
73 | } |
74 | print "not " if @r != $r; |
75 | print "ok 7\n"; |
76 | |
77 | # test if explicit glob() gets assign magic too |
78 | my @s = (); |
79 | while (glob '*/*.t') { |
80 | #print "# $_\n"; |
81 | push @s, $_; |
82 | } |
83 | print "not " if "@r" ne "@s"; |
84 | print "ok 8\n"; |
85 | |
86 | # how about in a different package, like? |
87 | package Foo; |
220398a0 |
88 | use File::Glob ':globally'; |
72b16652 |
89 | @s = (); |
90 | while (glob '*/*.t') { |
91 | #print "# $_\n"; |
92 | push @s, $_; |
93 | } |
94 | print "not " if "@r" ne "@s"; |
95 | print "ok 9\n"; |
96 | |
97 | # test if different glob ops maintain independent contexts |
98 | @s = (); |
99 | my $i = 0; |
100 | while (<*/*.t>) { |
101 | #print "# $_ <"; |
102 | push @s, $_; |
103 | while (<bas*/*.t>) { |
104 | #print " $_"; |
105 | $i++; |
106 | } |
107 | #print " >\n"; |
108 | } |
109 | print "not " if "@r" ne "@s" or not $i; |
110 | print "ok 10\n"; |