Commit | Line | Data |
4ea8f8fb |
1 | #!./perl |
2 | # |
3 | # Tests for Perl run-time environment variable settings |
4 | # |
5 | # $PERL5OPT, $PERL5LIB, etc. |
6 | |
7 | BEGIN { |
8 | chdir 't' if -d 't'; |
9 | @INC = '../lib'; |
e069d1ca |
10 | require Config; import Config; |
27dd2420 |
11 | unless ($Config{'d_fork'}) { |
12 | print "1..0 # Skip: no fork\n"; |
13 | exit 0; |
14 | } |
16570ae7 |
15 | require './test.pl' |
4ea8f8fb |
16 | } |
17 | |
e63be746 |
18 | plan tests => 78; |
659ca9ea |
19 | |
2d90ac95 |
20 | my $STDOUT = tempfile(); |
21 | my $STDERR = tempfile(); |
c8d62b71 |
22 | my $PERL = $ENV{PERL} || './perl'; |
4ea8f8fb |
23 | my $FAILURE_CODE = 119; |
24 | |
a0704631 |
25 | delete $ENV{PERLLIB}; |
26 | delete $ENV{PERL5LIB}; |
27 | delete $ENV{PERL5OPT}; |
28 | |
4ea8f8fb |
29 | |
d5226c4c |
30 | sub runperl_and_capture { |
31 | local *F; |
32 | my ($env, $args) = @_; |
4ea8f8fb |
33 | unshift @$args, '-I../lib'; |
34 | |
cd4e750a |
35 | local %ENV = %ENV; |
36 | delete $ENV{PERLLIB}; |
37 | delete $ENV{PERL5LIB}; |
38 | delete $ENV{PERL5OPT}; |
4ea8f8fb |
39 | my $pid = fork; |
40 | return (0, "Couldn't fork: $!") unless defined $pid; # failure |
41 | if ($pid) { # parent |
42 | my ($actual_stdout, $actual_stderr); |
43 | wait; |
44 | return (0, "Failure in child.\n") if ($?>>8) == $FAILURE_CODE; |
45 | |
46 | open F, "< $STDOUT" or return (0, "Couldn't read $STDOUT file"); |
47 | { local $/; $actual_stdout = <F> } |
48 | open F, "< $STDERR" or return (0, "Couldn't read $STDERR file"); |
49 | { local $/; $actual_stderr = <F> } |
50 | |
d5226c4c |
51 | return ($actual_stdout, $actual_stderr); |
4ea8f8fb |
52 | } else { # child |
53 | for my $k (keys %$env) { |
54 | $ENV{$k} = $env->{$k}; |
55 | } |
56 | open STDOUT, "> $STDOUT" or exit $FAILURE_CODE; |
57 | open STDERR, "> $STDERR" or it_didnt_work(); |
58 | { exec $PERL, @$args } |
59 | it_didnt_work(); |
60 | } |
61 | } |
62 | |
d5226c4c |
63 | # Run perl with specified environment and arguments returns a list. |
64 | # First element is true if Perl's stdout and stderr match the |
65 | # supplied $stdout and $stderr argument strings exactly. |
66 | # second element is an explanation of the failure |
67 | sub runperl { |
68 | local *F; |
69 | my ($env, $args, $stdout, $stderr) = @_; |
70 | my ($actual_stdout, $actual_stderr) = runperl_and_capture($env, $args); |
71 | if ($actual_stdout ne $stdout) { |
72 | return (0, "Stdout mismatch: expected [$stdout], saw [$actual_stdout]"); |
73 | } elsif ($actual_stderr ne $stderr) { |
74 | return (0, "Stderr mismatch: expected [$stderr], saw [$actual_stderr]"); |
75 | } else { |
76 | return 1; # success |
77 | } |
78 | } |
4ea8f8fb |
79 | |
80 | sub it_didnt_work { |
81 | print STDOUT "IWHCWJIHCI\cNHJWCJQWKJQJWCQW\n"; |
82 | exit $FAILURE_CODE; |
83 | } |
84 | |
85 | sub try { |
4ea8f8fb |
86 | my ($success, $reason) = runperl(@_); |
659ca9ea |
87 | $reason =~ s/\n/\\n/g if defined $reason; |
16570ae7 |
88 | local $::Level = $::Level + 1; |
89 | ok( $success, $reason ); |
4ea8f8fb |
90 | } |
91 | |
92 | # PERL5OPT Command-line options (switches). Switches in |
93 | # this variable are taken as if they were on |
1c4db469 |
94 | # every Perl command line. Only the -[DIMUdmtw] |
4ea8f8fb |
95 | # switches are allowed. When running taint |
96 | # checks (because the program was running setuid |
97 | # or setgid, or the -T switch was used), this |
98 | # variable is ignored. If PERL5OPT begins with |
99 | # -T, tainting will be enabled, and any |
100 | # subsequent options ignored. |
101 | |
659ca9ea |
102 | try({PERL5OPT => '-w'}, ['-e', 'print $::x'], |
4ea8f8fb |
103 | "", |
29489e7c |
104 | qq{Name "main::x" used only once: possible typo at -e line 1.\nUse of uninitialized value \$x in print at -e line 1.\n}); |
4ea8f8fb |
105 | |
659ca9ea |
106 | try({PERL5OPT => '-Mstrict'}, ['-e', 'print $::x'], |
4ea8f8fb |
107 | "", ""); |
108 | |
659ca9ea |
109 | try({PERL5OPT => '-Mstrict'}, ['-e', 'print $x'], |
4ea8f8fb |
110 | "", |
111 | qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n}); |
112 | |
113 | # Fails in 5.6.0 |
659ca9ea |
114 | try({PERL5OPT => '-Mstrict -w'}, ['-e', 'print $x'], |
4ea8f8fb |
115 | "", |
116 | qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n}); |
117 | |
118 | # Fails in 5.6.0 |
659ca9ea |
119 | try({PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'], |
4ea8f8fb |
120 | "", |
121 | <<ERROR |
122 | Name "main::x" used only once: possible typo at -e line 1. |
29489e7c |
123 | Use of uninitialized value \$x in print at -e line 1. |
4ea8f8fb |
124 | ERROR |
125 | ); |
126 | |
127 | # Fails in 5.6.0 |
659ca9ea |
128 | try({PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'], |
4ea8f8fb |
129 | "", |
130 | <<ERROR |
131 | Name "main::x" used only once: possible typo at -e line 1. |
29489e7c |
132 | Use of uninitialized value \$x in print at -e line 1. |
4ea8f8fb |
133 | ERROR |
134 | ); |
135 | |
659ca9ea |
136 | try({PERL5OPT => '-MExporter'}, ['-e0'], |
4ea8f8fb |
137 | "", |
138 | ""); |
139 | |
140 | # Fails in 5.6.0 |
659ca9ea |
141 | try({PERL5OPT => '-MExporter -MExporter'}, ['-e0'], |
4ea8f8fb |
142 | "", |
143 | ""); |
144 | |
659ca9ea |
145 | try({PERL5OPT => '-Mstrict -Mwarnings'}, |
4ea8f8fb |
146 | ['-e', 'print "ok" if $INC{"strict.pm"} and $INC{"warnings.pm"}'], |
147 | "ok", |
148 | ""); |
149 | |
e63be746 |
150 | open F, ">", "Oooof.pm" or die "Can't write Oooof.pm: $!"; |
151 | print F "package Oooof; 1;\n"; |
152 | close F; |
153 | END { 1 while unlink "Oooof.pm" } |
154 | |
155 | try({PERL5OPT => '-I. -MOooof'}, |
156 | ['-e', 'print "ok" if $INC{"Oooof.pm"} eq "Oooof.pm"'], |
157 | "ok", |
158 | ""); |
159 | |
160 | try({PERL5OPT => '-I./ -MOooof'}, |
161 | ['-e', 'print "ok" if $INC{"Oooof.pm"} eq "Oooof.pm"'], |
162 | "ok", |
163 | ""); |
164 | |
659ca9ea |
165 | try({PERL5OPT => '-w -w'}, |
166 | ['-e', 'print $ENV{PERL5OPT}'], |
167 | '-w -w', |
168 | ''); |
27dd2420 |
169 | |
1c4db469 |
170 | try({PERL5OPT => '-t'}, |
171 | ['-e', 'print ${^TAINT}'], |
9aa05f58 |
172 | '-1', |
1c4db469 |
173 | ''); |
174 | |
2b622f1a |
175 | try({PERL5OPT => '-W'}, |
176 | ['-e', 'local $^W = 0; no warnings; print $x'], |
177 | '', |
178 | <<ERROR |
179 | Name "main::x" used only once: possible typo at -e line 1. |
180 | Use of uninitialized value \$x in print at -e line 1. |
181 | ERROR |
182 | ); |
183 | |
cd4e750a |
184 | try({PERLLIB => "foobar$Config{path_sep}42"}, |
574c798a |
185 | ['-e', 'print grep { $_ eq "foobar" } @INC'], |
186 | 'foobar', |
187 | ''); |
188 | |
cd4e750a |
189 | try({PERLLIB => "foobar$Config{path_sep}42"}, |
574c798a |
190 | ['-e', 'print grep { $_ eq "42" } @INC'], |
191 | '42', |
192 | ''); |
193 | |
cd4e750a |
194 | try({PERL5LIB => "foobar$Config{path_sep}42"}, |
574c798a |
195 | ['-e', 'print grep { $_ eq "foobar" } @INC'], |
196 | 'foobar', |
197 | ''); |
198 | |
cd4e750a |
199 | try({PERL5LIB => "foobar$Config{path_sep}42"}, |
574c798a |
200 | ['-e', 'print grep { $_ eq "42" } @INC'], |
201 | '42', |
202 | ''); |
203 | |
a0704631 |
204 | try({PERL5LIB => "foo", |
205 | PERLLIB => "bar"}, |
206 | ['-e', 'print grep { $_ eq "foo" } @INC'], |
207 | 'foo', |
208 | ''); |
209 | |
210 | try({PERL5LIB => "foo", |
211 | PERLLIB => "bar"}, |
212 | ['-e', 'print grep { $_ eq "bar" } @INC'], |
213 | '', |
214 | ''); |
215 | |
72533a49 |
216 | # Tests for S_incpush_use_sep(): |
217 | |
218 | my @dump_inc = ('-e', 'print "$_\n" foreach @INC'); |
219 | |
220 | my ($out, $err) = runperl_and_capture({}, [@dump_inc]); |
221 | |
222 | is ($err, '', 'No errors when determining @INC'); |
223 | |
224 | my @default_inc = split /\n/, $out; |
225 | |
226 | is (shift @default_inc, '../lib', 'Our -I../lib is at the front'); |
227 | |
228 | my $sep = $Config{path_sep}; |
229 | foreach (['nothing', ''], |
230 | ['something', 'zwapp', 'zwapp'], |
231 | ['two things', "zwapp${sep}bam", 'zwapp', 'bam'], |
232 | ['two things, ::', "zwapp${sep}${sep}bam", 'zwapp', 'bam'], |
233 | [': at start', "${sep}zwapp", 'zwapp'], |
234 | [': at end', "zwapp${sep}", 'zwapp'], |
235 | [':: sandwich ::', "${sep}${sep}zwapp${sep}${sep}", 'zwapp'], |
236 | [':', "${sep}"], |
237 | ['::', "${sep}${sep}"], |
238 | [':::', "${sep}${sep}${sep}"], |
239 | ['two things and :', "zwapp${sep}bam${sep}", 'zwapp', 'bam'], |
240 | [': and two things', "${sep}zwapp${sep}bam", 'zwapp', 'bam'], |
241 | [': two things :', "${sep}zwapp${sep}bam${sep}", 'zwapp', 'bam'], |
242 | ['three things', "zwapp${sep}bam${sep}${sep}owww", |
243 | 'zwapp', 'bam', 'owww'], |
244 | ) { |
245 | my ($name, $lib, @expect) = @$_; |
246 | push @expect, @default_inc; |
247 | |
248 | ($out, $err) = runperl_and_capture({PERL5LIB => $lib}, [@dump_inc]); |
249 | |
250 | is ($err, '', "No errors when determining \@INC for $name"); |
251 | |
252 | my @inc = split /\n/, $out; |
253 | |
254 | is (shift @inc, '../lib', 'Our -I../lib is at the front for $name'); |
255 | |
256 | is (scalar @inc, scalar @expect, |
257 | "expected number of elements in \@INC for $name"); |
258 | |
259 | is ("@inc", "@expect", "expected elements in \@INC for $name"); |
260 | } |
261 | |
574c798a |
262 | # PERL5LIB tests with included arch directories still missing |
263 | |
27dd2420 |
264 | END { |
265 | 1 while unlink $STDOUT; |
266 | 1 while unlink $STDERR; |
267 | } |