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