3 # Tests for Perl run-time environment variable settings
5 # $PERL5OPT, $PERL5LIB, etc.
10 require Config; import Config;
12 skip_all_without_config('d_fork');
17 my $STDOUT = tempfile();
18 my $STDERR = tempfile();
19 my $PERL = $ENV{PERL} || './perl';
20 my $FAILURE_CODE = 119;
23 delete $ENV{PERL5LIB};
24 delete $ENV{PERL5OPT};
27 # Run perl with specified environment and arguments, return (STDOUT, STDERR)
28 sub runperl_and_capture {
30 my ($env, $args) = @_;
34 delete $ENV{PERL5LIB};
35 delete $ENV{PERL5OPT};
37 return (0, "Couldn't fork: $!") unless defined $pid; # failure
40 return (0, "Failure in child.\n") if ($?>>8) == $FAILURE_CODE;
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: $!");
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>);
51 for my $k (keys %$env) {
52 $ENV{$k} = $env->{$k};
54 open STDOUT, '>', $STDOUT or exit $FAILURE_CODE;
55 open STDERR, '>', $STDERR and do { exec $PERL, @$args };
57 print STDOUT "IWHCWJIHCI\cNHJWCJQWKJQJWCQW\n";
63 my ($env, $args, $stdout, $stderr) = @_;
64 my ($actual_stdout, $actual_stderr) = runperl_and_capture($env, $args);
65 local $::Level = $::Level + 1;
67 for my $k (sort keys %$env) {
68 push @envpairs, "$k => $env->{$k}";
70 my $label = join(',' => (@envpairs, @$args));
72 ok ( $actual_stdout =~/$stdout/, $label . ' stdout' );
74 is ( $actual_stdout, $stdout, $label . ' stdout' );
77 ok ( $actual_stderr =~/$stderr/, $label . ' stderr' );
79 is ( $actual_stderr, $stderr, $label . ' stderr' );
83 # PERL5OPT Command-line options (switches). Switches in
84 # this variable are taken as if they were on
85 # every Perl command line. Only the -[DIMUdmtw]
86 # switches are allowed. When running taint
87 # checks (because the program was running setuid
88 # or setgid, or the -T switch was used), this
89 # variable is ignored. If PERL5OPT begins with
90 # -T, tainting will be enabled, and any
91 # subsequent options ignored.
93 try({PERL5OPT => '-w'}, ['-e', 'print $::x'],
95 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});
97 try({PERL5OPT => '-Mstrict'}, ['-I../lib', '-e', 'print $::x'],
100 try({PERL5OPT => '-Mstrict'}, ['-I../lib', '-e', 'print $x'],
102 qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n});
105 try({PERL5OPT => '-Mstrict -w'}, ['-I../lib', '-e', 'print $x'],
107 qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n});
110 try({PERL5OPT => '-w -Mstrict'}, ['-I../lib', '-e', 'print $::x'],
113 Name "main::x" used only once: possible typo at -e line 1.
114 Use of uninitialized value \$x in print at -e line 1.
119 try({PERL5OPT => '-w -Mstrict'}, ['-I../lib', '-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.
127 try({PERL5OPT => '-MExporter'}, ['-I../lib', '-e0'],
132 try({PERL5OPT => '-MExporter -MExporter'}, ['-I../lib', '-e0'],
136 try({PERL5OPT => '-Mstrict -Mwarnings'},
137 ['-I../lib', '-e', 'print "ok" if $INC{"strict.pm"} and $INC{"warnings.pm"}'],
141 open my $fh, ">", "Oooof.pm" or die "Can't write Oooof.pm: $!";
142 print $fh "package Oooof; 1;\n";
144 END { 1 while unlink "Oooof.pm" }
146 try({PERL5OPT => '-I. -MOooof'},
147 ['-e', 'print "ok" if $INC{"Oooof.pm"} eq "Oooof.pm"'],
151 try({PERL5OPT => '-I./ -MOooof'},
152 ['-e', 'print "ok" if $INC{"Oooof.pm"} eq "Oooof.pm"'],
156 try({PERL5OPT => '-w -w'},
157 ['-e', 'print $ENV{PERL5OPT}'],
161 try({PERL5OPT => '-t'},
162 ['-e', 'print ${^TAINT}'],
166 try({PERL5OPT => '-W'},
167 ['-I../lib','-e', 'local $^W = 0; no warnings; print $x'],
170 Name "main::x" used only once: possible typo at -e line 1.
171 Use of uninitialized value \$x in print at -e line 1.
175 try({PERLLIB => "foobar$Config{path_sep}42"},
176 ['-e', 'print grep { $_ eq "foobar" } @INC'],
180 try({PERLLIB => "foobar$Config{path_sep}42"},
181 ['-e', 'print grep { $_ eq "42" } @INC'],
185 try({PERL5LIB => "foobar$Config{path_sep}42"},
186 ['-e', 'print grep { $_ eq "foobar" } @INC'],
190 try({PERL5LIB => "foobar$Config{path_sep}42"},
191 ['-e', 'print grep { $_ eq "42" } @INC'],
195 try({PERL5LIB => "foo",
197 ['-e', 'print grep { $_ eq "foo" } @INC'],
201 try({PERL5LIB => "foo",
203 ['-e', 'print grep { $_ eq "bar" } @INC'],
207 try({PERL_HASH_SEED_DEBUG => 1},
210 qr/HASH_FUNCTION =/);
212 try({PERL_HASH_SEED_DEBUG => 1},
217 try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "12345678"},
220 qr/HASH_SEED = 0x12345678/);
222 try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "12"},
225 qr/HASH_SEED = 0x12000000/);
227 try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "123456789"},
230 qr/HASH_SEED = 0x12345678/);
231 # Tests for S_incpush_use_sep():
233 my @dump_inc = ('-e', 'print "$_\n" foreach @INC');
235 my ($out, $err) = runperl_and_capture({}, [@dump_inc]);
237 is ($err, '', 'No errors when determining @INC');
239 my @default_inc = split /\n/, $out;
241 is ($default_inc[-1], '.', '. is last in @INC');
243 my $sep = $Config{path_sep};
244 foreach (['nothing', ''],
245 ['something', 'zwapp', 'zwapp'],
246 ['two things', "zwapp${sep}bam", 'zwapp', 'bam'],
247 ['two things, ::', "zwapp${sep}${sep}bam", 'zwapp', 'bam'],
248 [': at start', "${sep}zwapp", 'zwapp'],
249 [': at end', "zwapp${sep}", 'zwapp'],
250 [':: sandwich ::', "${sep}${sep}zwapp${sep}${sep}", 'zwapp'],
252 ['::', "${sep}${sep}"],
253 [':::', "${sep}${sep}${sep}"],
254 ['two things and :', "zwapp${sep}bam${sep}", 'zwapp', 'bam'],
255 [': and two things', "${sep}zwapp${sep}bam", 'zwapp', 'bam'],
256 [': two things :', "${sep}zwapp${sep}bam${sep}", 'zwapp', 'bam'],
257 ['three things', "zwapp${sep}bam${sep}${sep}owww",
258 'zwapp', 'bam', 'owww'],
260 my ($name, $lib, @expect) = @$_;
261 push @expect, @default_inc;
263 ($out, $err) = runperl_and_capture({PERL5LIB => $lib}, [@dump_inc]);
265 is ($err, '', "No errors when determining \@INC for $name");
267 my @inc = split /\n/, $out;
269 is (scalar @inc, scalar @expect,
270 "expected number of elements in \@INC for $name");
272 is ("@inc", "@expect", "expected elements in \@INC for $name");
275 # PERL5LIB tests with included arch directories still missing