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; |
27dd2420 JH |
11 | unless ($Config{'d_fork'}) { |
12 | print "1..0 # Skip: no fork\n"; | |
13 | exit 0; | |
14 | } | |
4ea8f8fb MS |
15 | } |
16 | ||
659ca9ea JH |
17 | use Test; |
18 | ||
a0704631 | 19 | plan tests => 17; |
659ca9ea | 20 | |
4ea8f8fb MS |
21 | my $STDOUT = './results-0'; |
22 | my $STDERR = './results-1'; | |
23 | my $PERL = './perl'; | |
24 | my $FAILURE_CODE = 119; | |
25 | ||
a0704631 SF |
26 | delete $ENV{PERLLIB}; |
27 | delete $ENV{PERL5LIB}; | |
28 | delete $ENV{PERL5OPT}; | |
29 | ||
4ea8f8fb | 30 | # Run perl with specified environment and arguments returns a list. |
1c4db469 | 31 | # First element is true if Perl's stdout and stderr match the |
4ea8f8fb MS |
32 | # supplied $stdout and $stderr argument strings exactly. |
33 | # second element is an explanation of the failure | |
34 | sub runperl { | |
35 | local *F; | |
36 | my ($env, $args, $stdout, $stderr) = @_; | |
37 | ||
38 | unshift @$args, '-I../lib'; | |
39 | ||
40 | $stdout = '' unless defined $stdout; | |
41 | $stderr = '' unless defined $stderr; | |
cd4e750a IZ |
42 | local %ENV = %ENV; |
43 | delete $ENV{PERLLIB}; | |
44 | delete $ENV{PERL5LIB}; | |
45 | delete $ENV{PERL5OPT}; | |
4ea8f8fb MS |
46 | my $pid = fork; |
47 | return (0, "Couldn't fork: $!") unless defined $pid; # failure | |
48 | if ($pid) { # parent | |
49 | my ($actual_stdout, $actual_stderr); | |
50 | wait; | |
51 | return (0, "Failure in child.\n") if ($?>>8) == $FAILURE_CODE; | |
52 | ||
53 | open F, "< $STDOUT" or return (0, "Couldn't read $STDOUT file"); | |
54 | { local $/; $actual_stdout = <F> } | |
55 | open F, "< $STDERR" or return (0, "Couldn't read $STDERR file"); | |
56 | { local $/; $actual_stderr = <F> } | |
57 | ||
58 | if ($actual_stdout ne $stdout) { | |
59 | return (0, "Stdout mismatch: expected [$stdout], saw [$actual_stdout]"); | |
60 | } elsif ($actual_stderr ne $stderr) { | |
61 | return (0, "Stderr mismatch: expected [$stderr], saw [$actual_stderr]"); | |
62 | } else { | |
63 | return 1; # success | |
64 | } | |
65 | } else { # child | |
66 | for my $k (keys %$env) { | |
67 | $ENV{$k} = $env->{$k}; | |
68 | } | |
69 | open STDOUT, "> $STDOUT" or exit $FAILURE_CODE; | |
70 | open STDERR, "> $STDERR" or it_didnt_work(); | |
71 | { exec $PERL, @$args } | |
72 | it_didnt_work(); | |
73 | } | |
74 | } | |
75 | ||
76 | ||
77 | sub it_didnt_work { | |
78 | print STDOUT "IWHCWJIHCI\cNHJWCJQWKJQJWCQW\n"; | |
79 | exit $FAILURE_CODE; | |
80 | } | |
81 | ||
82 | sub try { | |
4ea8f8fb | 83 | my ($success, $reason) = runperl(@_); |
659ca9ea JH |
84 | $reason =~ s/\n/\\n/g if defined $reason; |
85 | ok( !!$success, 1, $reason ); | |
4ea8f8fb MS |
86 | } |
87 | ||
88 | # PERL5OPT Command-line options (switches). Switches in | |
89 | # this variable are taken as if they were on | |
1c4db469 | 90 | # every Perl command line. Only the -[DIMUdmtw] |
4ea8f8fb MS |
91 | # switches are allowed. When running taint |
92 | # checks (because the program was running setuid | |
93 | # or setgid, or the -T switch was used), this | |
94 | # variable is ignored. If PERL5OPT begins with | |
95 | # -T, tainting will be enabled, and any | |
96 | # subsequent options ignored. | |
97 | ||
659ca9ea | 98 | try({PERL5OPT => '-w'}, ['-e', 'print $::x'], |
4ea8f8fb MS |
99 | "", |
100 | qq{Name "main::x" used only once: possible typo at -e line 1.\nUse of uninitialized value in print at -e line 1.\n}); | |
101 | ||
659ca9ea | 102 | try({PERL5OPT => '-Mstrict'}, ['-e', 'print $::x'], |
4ea8f8fb MS |
103 | "", ""); |
104 | ||
659ca9ea | 105 | try({PERL5OPT => '-Mstrict'}, ['-e', 'print $x'], |
4ea8f8fb MS |
106 | "", |
107 | qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n}); | |
108 | ||
109 | # Fails in 5.6.0 | |
659ca9ea | 110 | try({PERL5OPT => '-Mstrict -w'}, ['-e', 'print $x'], |
4ea8f8fb MS |
111 | "", |
112 | qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n}); | |
113 | ||
114 | # Fails in 5.6.0 | |
659ca9ea | 115 | try({PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'], |
4ea8f8fb MS |
116 | "", |
117 | <<ERROR | |
118 | Name "main::x" used only once: possible typo at -e line 1. | |
119 | Use of uninitialized value in print at -e line 1. | |
120 | ERROR | |
121 | ); | |
122 | ||
123 | # Fails in 5.6.0 | |
659ca9ea | 124 | try({PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'], |
4ea8f8fb MS |
125 | "", |
126 | <<ERROR | |
127 | Name "main::x" used only once: possible typo at -e line 1. | |
128 | Use of uninitialized value in print at -e line 1. | |
129 | ERROR | |
130 | ); | |
131 | ||
659ca9ea | 132 | try({PERL5OPT => '-MExporter'}, ['-e0'], |
4ea8f8fb MS |
133 | "", |
134 | ""); | |
135 | ||
136 | # Fails in 5.6.0 | |
659ca9ea | 137 | try({PERL5OPT => '-MExporter -MExporter'}, ['-e0'], |
4ea8f8fb MS |
138 | "", |
139 | ""); | |
140 | ||
659ca9ea | 141 | try({PERL5OPT => '-Mstrict -Mwarnings'}, |
4ea8f8fb MS |
142 | ['-e', 'print "ok" if $INC{"strict.pm"} and $INC{"warnings.pm"}'], |
143 | "ok", | |
144 | ""); | |
145 | ||
659ca9ea JH |
146 | try({PERL5OPT => '-w -w'}, |
147 | ['-e', 'print $ENV{PERL5OPT}'], | |
148 | '-w -w', | |
149 | ''); | |
27dd2420 | 150 | |
1c4db469 RGS |
151 | try({PERL5OPT => '-t'}, |
152 | ['-e', 'print ${^TAINT}'], | |
9aa05f58 | 153 | '-1', |
1c4db469 RGS |
154 | ''); |
155 | ||
cd4e750a | 156 | try({PERLLIB => "foobar$Config{path_sep}42"}, |
574c798a SR |
157 | ['-e', 'print grep { $_ eq "foobar" } @INC'], |
158 | 'foobar', | |
159 | ''); | |
160 | ||
cd4e750a | 161 | try({PERLLIB => "foobar$Config{path_sep}42"}, |
574c798a SR |
162 | ['-e', 'print grep { $_ eq "42" } @INC'], |
163 | '42', | |
164 | ''); | |
165 | ||
cd4e750a | 166 | try({PERL5LIB => "foobar$Config{path_sep}42"}, |
574c798a SR |
167 | ['-e', 'print grep { $_ eq "foobar" } @INC'], |
168 | 'foobar', | |
169 | ''); | |
170 | ||
cd4e750a | 171 | try({PERL5LIB => "foobar$Config{path_sep}42"}, |
574c798a SR |
172 | ['-e', 'print grep { $_ eq "42" } @INC'], |
173 | '42', | |
174 | ''); | |
175 | ||
a0704631 SF |
176 | try({PERL5LIB => "foo", |
177 | PERLLIB => "bar"}, | |
178 | ['-e', 'print grep { $_ eq "foo" } @INC'], | |
179 | 'foo', | |
180 | ''); | |
181 | ||
182 | try({PERL5LIB => "foo", | |
183 | PERLLIB => "bar"}, | |
184 | ['-e', 'print grep { $_ eq "bar" } @INC'], | |
185 | '', | |
186 | ''); | |
187 | ||
574c798a SR |
188 | # PERL5LIB tests with included arch directories still missing |
189 | ||
27dd2420 JH |
190 | END { |
191 | 1 while unlink $STDOUT; | |
192 | 1 while unlink $STDERR; | |
193 | } |