3 # Tests for Perl run-time environment variable settings
5 # $PERL5OPT, $PERL5LIB, etc.
10 require Config; import Config;
11 unless ($Config{'d_fork'}) {
12 print "1..0 # Skip: no fork\n";
20 my $STDOUT = tempfile();
21 my $STDERR = tempfile();
22 my $PERL = $ENV{PERL} || './perl';
23 my $FAILURE_CODE = 119;
26 delete $ENV{PERL5LIB};
27 delete $ENV{PERL5OPT};
30 sub runperl_and_capture {
32 my ($env, $args) = @_;
33 unshift @$args, '-I../lib';
37 delete $ENV{PERL5LIB};
38 delete $ENV{PERL5OPT};
40 return (0, "Couldn't fork: $!") unless defined $pid; # failure
42 my ($actual_stdout, $actual_stderr);
44 return (0, "Failure in child.\n") if ($?>>8) == $FAILURE_CODE;
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> }
51 return ($actual_stdout, $actual_stderr);
53 for my $k (keys %$env) {
54 $ENV{$k} = $env->{$k};
56 open STDOUT, "> $STDOUT" or exit $FAILURE_CODE;
57 open STDERR, "> $STDERR" or it_didnt_work();
58 { exec $PERL, @$args }
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
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]");
81 print STDOUT "IWHCWJIHCI\cNHJWCJQWKJQJWCQW\n";
86 my ($success, $reason) = runperl(@_);
87 $reason =~ s/\n/\\n/g if defined $reason;
88 local $::Level = $::Level + 1;
89 ok( $success, $reason );
92 # PERL5OPT Command-line options (switches). Switches in
93 # this variable are taken as if they were on
94 # every Perl command line. Only the -[DIMUdmtw]
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.
102 try({PERL5OPT => '-w'}, ['-e', 'print $::x'],
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});
106 try({PERL5OPT => '-Mstrict'}, ['-e', 'print $::x'],
109 try({PERL5OPT => '-Mstrict'}, ['-e', 'print $x'],
111 qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n});
114 try({PERL5OPT => '-Mstrict -w'}, ['-e', 'print $x'],
116 qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n});
119 try({PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'],
122 Name "main::x" used only once: possible typo at -e line 1.
123 Use of uninitialized value \$x in print at -e line 1.
128 try({PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'],
131 Name "main::x" used only once: possible typo at -e line 1.
132 Use of uninitialized value \$x in print at -e line 1.
136 try({PERL5OPT => '-MExporter'}, ['-e0'],
141 try({PERL5OPT => '-MExporter -MExporter'}, ['-e0'],
145 try({PERL5OPT => '-Mstrict -Mwarnings'},
146 ['-e', 'print "ok" if $INC{"strict.pm"} and $INC{"warnings.pm"}'],
150 open F, ">", "Oooof.pm" or die "Can't write Oooof.pm: $!";
151 print F "package Oooof; 1;\n";
153 END { 1 while unlink "Oooof.pm" }
155 try({PERL5OPT => '-I. -MOooof'},
156 ['-e', 'print "ok" if $INC{"Oooof.pm"} eq "Oooof.pm"'],
160 try({PERL5OPT => '-I./ -MOooof'},
161 ['-e', 'print "ok" if $INC{"Oooof.pm"} eq "Oooof.pm"'],
165 try({PERL5OPT => '-w -w'},
166 ['-e', 'print $ENV{PERL5OPT}'],
170 try({PERL5OPT => '-t'},
171 ['-e', 'print ${^TAINT}'],
175 try({PERL5OPT => '-W'},
176 ['-e', 'local $^W = 0; no warnings; print $x'],
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.
184 try({PERLLIB => "foobar$Config{path_sep}42"},
185 ['-e', 'print grep { $_ eq "foobar" } @INC'],
189 try({PERLLIB => "foobar$Config{path_sep}42"},
190 ['-e', 'print grep { $_ eq "42" } @INC'],
194 try({PERL5LIB => "foobar$Config{path_sep}42"},
195 ['-e', 'print grep { $_ eq "foobar" } @INC'],
199 try({PERL5LIB => "foobar$Config{path_sep}42"},
200 ['-e', 'print grep { $_ eq "42" } @INC'],
204 try({PERL5LIB => "foo",
206 ['-e', 'print grep { $_ eq "foo" } @INC'],
210 try({PERL5LIB => "foo",
212 ['-e', 'print grep { $_ eq "bar" } @INC'],
216 # Tests for S_incpush_use_sep():
218 my @dump_inc = ('-e', 'print "$_\n" foreach @INC');
220 my ($out, $err) = runperl_and_capture({}, [@dump_inc]);
222 is ($err, '', 'No errors when determining @INC');
224 my @default_inc = split /\n/, $out;
226 is (shift @default_inc, '../lib', 'Our -I../lib is at the front');
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'],
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'],
245 my ($name, $lib, @expect) = @$_;
246 push @expect, @default_inc;
248 ($out, $err) = runperl_and_capture({PERL5LIB => $lib}, [@dump_inc]);
250 is ($err, '', "No errors when determining \@INC for $name");
252 my @inc = split /\n/, $out;
254 is (shift @inc, '../lib', 'Our -I../lib is at the front for $name');
256 is (scalar @inc, scalar @expect,
257 "expected number of elements in \@INC for $name");
259 is ("@inc", "@expect", "expected elements in \@INC for $name");
262 # PERL5LIB tests with included arch directories still missing
265 1 while unlink $STDOUT;
266 1 while unlink $STDERR;