Commit | Line | Data |
---|---|---|
1fcb0052 PM |
1 | #!./perl |
2 | # | |
3 | # Tests for Perl run-time environment variable settings | |
4 | # Clone of t/run/runenv.t but without the forking, and with cmd.exe-friendly -e syntax. | |
5 | # | |
6 | # $PERL5OPT, $PERL5LIB, etc. | |
7 | ||
8 | BEGIN { | |
9 | chdir 't' if -d 't'; | |
10 | @INC = '../lib'; | |
11 | require Config; import Config; | |
12 | require File::Temp; import File::Temp qw/:POSIX/; | |
13 | ||
14 | require Win32; | |
15 | ($::os_id, $::os_major) = ( Win32::GetOSVersion() )[ 4, 1 ]; | |
16 | if ($::os_id == 2 and $::os_major == 6) { # Vista, Server 2008 (incl R2), 7 | |
17 | $::tests = 43; | |
18 | } | |
19 | else { | |
c6537db3 | 20 | $::tests = 40; |
1fcb0052 PM |
21 | } |
22 | ||
23 | require './test.pl'; | |
24 | } | |
25 | ||
28b4adf4 RS |
26 | skip_all "requires compilation with PERL_IMPLICIT_SYS" |
27 | unless $Config{ccflags} =~/(?:\A|\s)-DPERL_IMPLICIT_SYS\b/; | |
28 | ||
1fcb0052 PM |
29 | plan tests => $::tests; |
30 | ||
463c96de | 31 | my $PERL = '.\perl'; |
1fcb0052 PM |
32 | my $NL = $/; |
33 | ||
34 | delete $ENV{PERLLIB}; | |
35 | delete $ENV{PERL5LIB}; | |
36 | delete $ENV{PERL5OPT}; | |
37 | ||
38 | ||
39 | # Run perl with specified environment and arguments, return (STDOUT, STDERR) | |
40 | sub runperl_and_capture { | |
41 | my ($env, $args) = @_; | |
42 | ||
43 | # Clear out old env | |
44 | local %ENV = %ENV; | |
45 | delete $ENV{PERLLIB}; | |
46 | delete $ENV{PERL5LIB}; | |
47 | delete $ENV{PERL5OPT}; | |
48 | ||
49 | # Populate with our desired env | |
50 | for my $k (keys %$env) { | |
51 | $ENV{$k} = $env->{$k}; | |
52 | } | |
53 | ||
54 | # This is slightly expensive, but this is more reliable than | |
55 | # trying to emulate fork(), and we still get STDERR and STDOUT individually. | |
56 | my $stderr_cache = tmpnam(); | |
57 | my $stdout = `$PERL @$args 2>$stderr_cache`; | |
58 | my $stderr = ''; | |
59 | if (-s $stderr_cache) { | |
60 | open(my $stderr_cache_fh, "<", $stderr_cache) | |
61 | or die "Could not retrieve STDERR output: $!"; | |
62 | while ( defined(my $s_line = <$stderr_cache_fh>) ) { | |
63 | $stderr .= $s_line; | |
64 | } | |
65 | close $stderr_cache_fh; | |
66 | unlink $stderr_cache; | |
67 | } | |
68 | ||
69 | return ($stdout, $stderr); | |
70 | } | |
71 | ||
72 | sub try { | |
73 | my ($env, $args, $stdout, $stderr) = @_; | |
74 | my ($actual_stdout, $actual_stderr) = runperl_and_capture($env, $args); | |
75 | local $::Level = $::Level + 1; | |
86f5deca JK |
76 | is $actual_stdout, $stdout; |
77 | is $actual_stderr, $stderr; | |
1fcb0052 PM |
78 | } |
79 | ||
80 | # PERL5OPT Command-line options (switches). Switches in | |
81 | # this variable are taken as if they were on | |
82 | # every Perl command line. Only the -[DIMUdmtw] | |
83 | # switches are allowed. When running taint | |
84 | # checks (because the program was running setuid | |
85 | # or setgid, or the -T switch was used), this | |
86 | # variable is ignored. If PERL5OPT begins with | |
87 | # -T, tainting will be enabled, and any | |
88 | # subsequent options ignored. | |
89 | ||
90 | try({PERL5OPT => '-w'}, ['-e', '"print $::x"'], | |
91 | "", | |
92 | qq(Name "main::x" used only once: possible typo at -e line 1.${NL}Use of uninitialized value \$x in print at -e line 1.${NL})); | |
93 | ||
94 | try({PERL5OPT => '-Mstrict'}, ['-I..\lib', '-e', '"print $::x"'], | |
95 | "", ""); | |
96 | ||
97 | try({PERL5OPT => '-Mstrict'}, ['-I..\lib', '-e', '"print $x"'], | |
98 | "", | |
d8c6310a | 99 | qq(Global symbol "\$x" requires explicit package name (did you forget to declare "my \$x"?) at -e line 1.${NL}Execution of -e aborted due to compilation errors.${NL})); |
1fcb0052 PM |
100 | |
101 | # Fails in 5.6.0 | |
102 | try({PERL5OPT => '-Mstrict -w'}, ['-I..\lib', '-e', '"print $x"'], | |
103 | "", | |
d8c6310a | 104 | qq(Global symbol "\$x" requires explicit package name (did you forget to declare "my \$x"?) at -e line 1.${NL}Execution of -e aborted due to compilation errors.${NL})); |
1fcb0052 PM |
105 | |
106 | # Fails in 5.6.0 | |
107 | try({PERL5OPT => '-w -Mstrict'}, ['-I..\lib', '-e', '"print $::x"'], | |
108 | "", | |
109 | <<ERROR | |
110 | Name "main::x" used only once: possible typo at -e line 1. | |
111 | Use of uninitialized value \$x in print at -e line 1. | |
112 | ERROR | |
113 | ); | |
114 | ||
115 | # Fails in 5.6.0 | |
116 | try({PERL5OPT => '-w -Mstrict'}, ['-I..\lib', '-e', '"print $::x"'], | |
117 | "", | |
118 | <<ERROR | |
119 | Name "main::x" used only once: possible typo at -e line 1. | |
120 | Use of uninitialized value \$x in print at -e line 1. | |
121 | ERROR | |
122 | ); | |
123 | ||
124 | try({PERL5OPT => '-MExporter'}, ['-I..\lib', '-e0'], | |
125 | "", | |
126 | ""); | |
127 | ||
128 | # Fails in 5.6.0 | |
129 | try({PERL5OPT => '-MExporter -MExporter'}, ['-I..\lib', '-e0'], | |
130 | "", | |
131 | ""); | |
132 | ||
133 | try({PERL5OPT => '-Mstrict -Mwarnings'}, | |
134 | ['-I..\lib', '-e', '"print \"ok\" if $INC{\"strict.pm\"} and $INC{\"warnings.pm\"}"'], | |
135 | "ok", | |
136 | ""); | |
137 | ||
138 | open my $fh, ">", "Oooof.pm" or die "Can't write Oooof.pm: $!"; | |
139 | print $fh "package Oooof; 1;\n"; | |
140 | close $fh; | |
141 | END { 1 while unlink "Oooof.pm" } | |
142 | ||
143 | try({PERL5OPT => '-I. -MOooof'}, | |
144 | ['-e', '"print \"ok\" if $INC{\"Oooof.pm\"} eq \"Oooof.pm\""'], | |
145 | "ok", | |
146 | ""); | |
147 | ||
148 | try({PERL5OPT => '-w -w'}, | |
149 | ['-e', '"print $ENV{PERL5OPT}"'], | |
150 | '-w -w', | |
151 | ''); | |
152 | ||
153 | try({PERL5OPT => '-t'}, | |
154 | ['-e', '"print ${^TAINT}"'], | |
155 | '-1', | |
156 | ''); | |
157 | ||
158 | try({PERL5OPT => '-W'}, | |
159 | ['-I..\lib','-e', '"local $^W = 0; no warnings; print $x"'], | |
160 | '', | |
161 | <<ERROR | |
162 | Name "main::x" used only once: possible typo at -e line 1. | |
163 | Use of uninitialized value \$x in print at -e line 1. | |
164 | ERROR | |
165 | ); | |
166 | ||
167 | try({PERLLIB => "foobar$Config{path_sep}42"}, | |
168 | ['-e', '"print grep { $_ eq \"foobar\" } @INC"'], | |
169 | 'foobar', | |
170 | ''); | |
171 | ||
172 | try({PERLLIB => "foobar$Config{path_sep}42"}, | |
173 | ['-e', '"print grep { $_ eq \"42\" } @INC"'], | |
174 | '42', | |
175 | ''); | |
176 | ||
177 | try({PERL5LIB => "foobar$Config{path_sep}42"}, | |
178 | ['-e', '"print grep { $_ eq \"foobar\" } @INC"'], | |
179 | 'foobar', | |
180 | ''); | |
181 | ||
182 | try({PERL5LIB => "foobar$Config{path_sep}42"}, | |
183 | ['-e', '"print grep { $_ eq \"42\" } @INC"'], | |
184 | '42', | |
185 | ''); | |
186 | ||
187 | try({PERL5LIB => "foo", | |
188 | PERLLIB => "bar"}, | |
189 | ['-e', '"print grep { $_ eq \"foo\" } @INC"'], | |
190 | 'foo', | |
191 | ''); | |
192 | ||
193 | try({PERL5LIB => "foo", | |
194 | PERLLIB => "bar"}, | |
195 | ['-e', '"print grep { $_ eq \"bar\" } @INC"'], | |
196 | '', | |
197 | ''); | |
198 | ||
199 | # Tests for S_incpush_use_sep(): | |
200 | ||
201 | my @dump_inc = ('-e', '"print \"$_\n\" foreach @INC"'); | |
202 | ||
203 | my ($out, $err) = runperl_and_capture({}, [@dump_inc]); | |
204 | ||
205 | is ($err, '', 'No errors when determining @INC'); | |
206 | ||
207 | my @default_inc = split /\n/, $out; | |
208 | ||
209 | is ($default_inc[-1], '.', '. is last in @INC'); | |
210 | ||
211 | my $sep = $Config{path_sep}; | |
212 | my @test_cases = ( | |
213 | ['nothing', ''], | |
214 | ['something', 'zwapp', 'zwapp'], | |
215 | ['two things', "zwapp${sep}bam", 'zwapp', 'bam'], | |
216 | ['two things, ::', "zwapp${sep}${sep}bam", 'zwapp', 'bam'], | |
217 | [': at start', "${sep}zwapp", 'zwapp'], | |
218 | [': at end', "zwapp${sep}", 'zwapp'], | |
219 | [':: sandwich ::', "${sep}${sep}zwapp${sep}${sep}", 'zwapp'], | |
220 | [':', "${sep}"], | |
221 | ['::', "${sep}${sep}"], | |
222 | [':::', "${sep}${sep}${sep}"], | |
223 | ['two things and :', "zwapp${sep}bam${sep}", 'zwapp', 'bam'], | |
224 | [': and two things', "${sep}zwapp${sep}bam", 'zwapp', 'bam'], | |
225 | [': two things :', "${sep}zwapp${sep}bam${sep}", 'zwapp', 'bam'], | |
226 | ['three things', "zwapp${sep}bam${sep}${sep}owww", | |
227 | 'zwapp', 'bam', 'owww'], | |
228 | ); | |
229 | ||
230 | # This block added to verify fix for RT #87322 | |
231 | if ($::os_id == 2 and $::os_major == 6) { # Vista, Server 2008 (incl R2), 7 | |
232 | my @big_perl5lib = ('z' x 16) x 2049; | |
233 | push @testcases, [ | |
234 | 'enough items so PERL5LIB val is longer than 32k', | |
235 | join($sep, @big_perl5lib), @big_perl5lib, | |
236 | ]; | |
237 | } | |
238 | ||
239 | foreach ( @testcases ) { | |
240 | my ($name, $lib, @expect) = @$_; | |
241 | push @expect, @default_inc; | |
242 | ||
243 | ($out, $err) = runperl_and_capture({PERL5LIB => $lib}, [@dump_inc]); | |
244 | ||
245 | is ($err, '', "No errors when determining \@INC for $name"); | |
246 | ||
247 | my @inc = split /\n/, $out; | |
248 | ||
249 | is (scalar @inc, scalar @expect, | |
250 | "expected number of elements in \@INC for $name"); | |
251 | ||
252 | is ("@inc", "@expect", "expected elements in \@INC for $name"); | |
253 | } |