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