Commit | Line | Data |
---|---|---|
4ea8f8fb MS |
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 JH |
11 | unless ($Config{'d_fork'}) { |
12 | print "1..0 # Skip: no fork\n"; | |
13 | exit 0; | |
14 | } | |
16570ae7 | 15 | require './test.pl' |
4ea8f8fb MS |
16 | } |
17 | ||
e63be746 | 18 | plan tests => 78; |
659ca9ea | 19 | |
2d90ac95 NC |
20 | my $STDOUT = tempfile(); |
21 | my $STDERR = tempfile(); | |
c8d62b71 | 22 | my $PERL = $ENV{PERL} || './perl'; |
4ea8f8fb MS |
23 | my $FAILURE_CODE = 119; |
24 | ||
a0704631 SF |
25 | delete $ENV{PERLLIB}; |
26 | delete $ENV{PERL5LIB}; | |
27 | delete $ENV{PERL5OPT}; | |
28 | ||
4ea8f8fb | 29 | |
d5226c4c NC |
30 | sub runperl_and_capture { |
31 | local *F; | |
32 | my ($env, $args) = @_; | |
4ea8f8fb MS |
33 | unshift @$args, '-I../lib'; |
34 | ||
cd4e750a IZ |
35 | local %ENV = %ENV; |
36 | delete $ENV{PERLLIB}; | |
37 | delete $ENV{PERL5LIB}; | |
38 | delete $ENV{PERL5OPT}; | |
4ea8f8fb MS |
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 MS |
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 NC |
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 MS |
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 NC |
88 | local $::Level = $::Level + 1; |
89 | ok( $success, $reason ); | |
4ea8f8fb MS |
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 MS |
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 MS |
107 | "", ""); |
108 | ||
659ca9ea | 109 | try({PERL5OPT => '-Mstrict'}, ['-e', 'print $x'], |
4ea8f8fb MS |
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 MS |
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 MS |
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 MS |
124 | ERROR |
125 | ); | |
126 | ||
127 | # Fails in 5.6.0 | |
659ca9ea | 128 | try({PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'], |
4ea8f8fb MS |
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 MS |
133 | ERROR |
134 | ); | |
135 | ||
659ca9ea | 136 | try({PERL5OPT => '-MExporter'}, ['-e0'], |
4ea8f8fb MS |
137 | "", |
138 | ""); | |
139 | ||
140 | # Fails in 5.6.0 | |
659ca9ea | 141 | try({PERL5OPT => '-MExporter -MExporter'}, ['-e0'], |
4ea8f8fb MS |
142 | "", |
143 | ""); | |
144 | ||
659ca9ea | 145 | try({PERL5OPT => '-Mstrict -Mwarnings'}, |
4ea8f8fb MS |
146 | ['-e', 'print "ok" if $INC{"strict.pm"} and $INC{"warnings.pm"}'], |
147 | "ok", | |
148 | ""); | |
149 | ||
e63be746 RGS |
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 JH |
165 | try({PERL5OPT => '-w -w'}, |
166 | ['-e', 'print $ENV{PERL5OPT}'], | |
167 | '-w -w', | |
168 | ''); | |
27dd2420 | 169 | |
1c4db469 RGS |
170 | try({PERL5OPT => '-t'}, |
171 | ['-e', 'print ${^TAINT}'], | |
9aa05f58 | 172 | '-1', |
1c4db469 RGS |
173 | ''); |
174 | ||
2b622f1a MS |
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 SR |
185 | ['-e', 'print grep { $_ eq "foobar" } @INC'], |
186 | 'foobar', | |
187 | ''); | |
188 | ||
cd4e750a | 189 | try({PERLLIB => "foobar$Config{path_sep}42"}, |
574c798a SR |
190 | ['-e', 'print grep { $_ eq "42" } @INC'], |
191 | '42', | |
192 | ''); | |
193 | ||
cd4e750a | 194 | try({PERL5LIB => "foobar$Config{path_sep}42"}, |
574c798a SR |
195 | ['-e', 'print grep { $_ eq "foobar" } @INC'], |
196 | 'foobar', | |
197 | ''); | |
198 | ||
cd4e750a | 199 | try({PERL5LIB => "foobar$Config{path_sep}42"}, |
574c798a SR |
200 | ['-e', 'print grep { $_ eq "42" } @INC'], |
201 | '42', | |
202 | ''); | |
203 | ||
a0704631 SF |
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 NC |
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 SR |
262 | # PERL5LIB tests with included arch directories still missing |
263 | ||
27dd2420 JH |
264 | END { |
265 | 1 while unlink $STDOUT; | |
266 | 1 while unlink $STDERR; | |
267 | } |