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