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