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