This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
t/run/runenv.t bug
[perl5.git] / t / run / runenv.t
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';
10     require Config; import Config;
11     unless ($Config{'d_fork'}) {
12         print "1..0 # Skip: no fork\n";
13             exit 0;
14     }
15 }
16
17 use Test;
18
19 plan tests => 17;
20
21 my $STDOUT = './results-0';
22 my $STDERR = './results-1';
23 my $PERL = './perl';
24 my $FAILURE_CODE = 119;
25
26 delete $ENV{PERLLIB};
27 delete $ENV{PERL5LIB};
28 delete $ENV{PERL5OPT};
29
30 # Run perl with specified environment and arguments returns a list.
31 # First element is true if Perl's stdout and stderr match the
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 {
79   my ($success, $reason) = runperl(@_);
80   $reason =~ s/\n/\\n/g if defined $reason;
81   ok( !!$success, 1, $reason );
82 }
83
84 #  PERL5OPT    Command-line options (switches).  Switches in
85 #                    this variable are taken as if they were on
86 #                    every Perl command line.  Only the -[DIMUdmtw]
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
94 try({PERL5OPT => '-w'}, ['-e', 'print $::x'],
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
98 try({PERL5OPT => '-Mstrict'}, ['-e', 'print $::x'],
99     "", "");
100
101 try({PERL5OPT => '-Mstrict'}, ['-e', 'print $x'],
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
106 try({PERL5OPT => '-Mstrict -w'}, ['-e', 'print $x'],
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
111 try({PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'],
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
120 try({PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'],
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
128 try({PERL5OPT => '-MExporter'}, ['-e0'],
129     "", 
130     "");
131
132 # Fails in 5.6.0
133 try({PERL5OPT => '-MExporter -MExporter'}, ['-e0'],
134     "", 
135     "");
136
137 try({PERL5OPT => '-Mstrict -Mwarnings'}, 
138     ['-e', 'print "ok" if $INC{"strict.pm"} and $INC{"warnings.pm"}'],
139     "ok",
140     "");
141
142 try({PERL5OPT => '-w -w'},
143     ['-e', 'print $ENV{PERL5OPT}'],
144     '-w -w',
145     '');
146
147 try({PERL5OPT => '-t'},
148     ['-e', 'print ${^TAINT}'],
149     '1',
150     '');
151
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
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
184 # PERL5LIB tests with included arch directories still missing
185
186 END {
187     1 while unlink $STDOUT;
188     1 while unlink $STDERR;
189 }