xref: /openbsd/gnu/usr.bin/perl/ext/File-Glob/t/global.t (revision 404b540a) 
1#!./perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    if ($^O eq 'MacOS') {
6	@INC = qw(: ::lib ::macos:lib);
7    } else {
8	@INC = '.';
9	push @INC, '../lib';
10    }
11    require Config; import Config;
12    if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
13        print "1..0\n";
14        exit 0;
15    }
16    print "1..10\n";
17}
18END {
19    print "not ok 1\n" unless $loaded;
20}
21
22BEGIN {
23    *CORE::GLOBAL::glob = sub { "Just another Perl hacker," };
24}
25
26BEGIN {
27    if ("Just another Perl hacker," ne (<*>)[0]) {
28        die <<EOMessage;
29Your version of perl ($]) doesn't seem to allow extensions to override
30the core glob operator.
31EOMessage
32    }
33}
34
35use File::Glob ':globally';
36$loaded = 1;
37print "ok 1\n";
38
39$_ = $^O eq "MacOS" ? ":op:*.t" : "op/*.t";
40my @r = glob;
41print "not " if $_ ne ($^O eq "MacOS" ? ":op:*.t" : "op/*.t");
42print "ok 2\n";
43
44print "# |@r|\nnot " if @r < 3;
45print "ok 3\n";
46
47# check if <*/*> works
48if ($^O eq "MacOS") {
49    @r = <:*:*.t>;
50} else {
51    @r = <*/*.t>;
52}
53# at least t/global.t t/basic.t, t/taint.t
54print "not " if @r < 3;
55print "ok 4\n";
56my $r = scalar @r;
57
58# check if scalar context works
59@r = ();
60if ($^O eq "MacOS") {
61    while (defined($_ = <:*:*.t>)) {
62	#print "# $_\n";
63	push @r, $_;
64    }
65} else {
66    while (defined($_ = <*/*.t>)) {
67	#print "# $_\n";
68	push @r, $_;
69    }
70}
71print "not " if @r != $r;
72print "ok 5\n";
73
74# check if list context works
75@r = ();
76if ($^O eq "MacOS") {
77    for (<:*:*.t>) {
78	#print "# $_\n";
79	push @r, $_;
80    }
81} else {
82    for (<*/*.t>) {
83	#print "# $_\n";
84	push @r, $_;
85    }
86}
87print "not " if @r != $r;
88print "ok 6\n";
89
90# test if implicit assign to $_ in while() works
91@r = ();
92if ($^O eq "MacOS") {
93    while (<:*:*.t>) {
94	#print "# $_\n";
95	push @r, $_;
96    }
97} else {
98    while (<*/*.t>) {
99	#print "# $_\n";
100	push @r, $_;
101    }
102}
103print "not " if @r != $r;
104print "ok 7\n";
105
106# test if explicit glob() gets assign magic too
107my @s = ();
108while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) {
109    #print "# $_\n";
110    push @s, $_;
111}
112print "not " if "@r" ne "@s";
113print "ok 8\n";
114
115# how about in a different package, like?
116package Foo;
117use File::Glob ':globally';
118@s = ();
119while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) {
120    #print "# $_\n";
121    push @s, $_;
122}
123print "not " if "@r" ne "@s";
124print "ok 9\n";
125
126# test if different glob ops maintain independent contexts
127@s = ();
128my $i = 0;
129if ($^O eq "MacOS") {
130    while (<:*:*.t>) {
131	#print "# $_ <";
132	push @s, $_;
133	while (<:bas*:*.t>) {
134	    #print " $_";
135	    $i++;
136	}
137	#print " >\n";
138    }
139} else {
140    while (<*/*.t>) {
141	#print "# $_ <";
142	push @s, $_;
143	while (<bas*/*.t>) {
144	    #print " $_";
145	    $i++;
146	}
147	#print " >\n";
148    }
149}
150print "not " if "@r" ne "@s" or not $i;
151print "ok 10\n";
152