This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Convert all unimaginative (ie race condition) temporary file names to
[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     require './test.pl'
16 }
17
18 plan tests => 17;
19
20 my $STDOUT = tempfile();
21 my $STDERR = tempfile();
22 my $PERL = $ENV{PERL} || './perl';
23 my $FAILURE_CODE = 119;
24
25 delete $ENV{PERLLIB};
26 delete $ENV{PERL5LIB};
27 delete $ENV{PERL5OPT};
28
29 # Run perl with specified environment and arguments returns a list.
30 # First element is true if Perl's stdout and stderr match the
31 # supplied $stdout and $stderr argument strings exactly.
32 # second element is an explanation of the failure
33 sub runperl {
34   local *F;
35   my ($env, $args, $stdout, $stderr) = @_;
36
37   unshift @$args, '-I../lib';
38
39   $stdout = '' unless defined $stdout;
40   $stderr = '' unless defined $stderr;
41   local %ENV = %ENV;
42   delete $ENV{PERLLIB};
43   delete $ENV{PERL5LIB};
44   delete $ENV{PERL5OPT};
45   my $pid = fork;
46   return (0, "Couldn't fork: $!") unless defined $pid;   # failure
47   if ($pid) {                   # parent
48     my ($actual_stdout, $actual_stderr);
49     wait;
50     return (0, "Failure in child.\n") if ($?>>8) == $FAILURE_CODE;
51
52     open F, "< $STDOUT" or return (0, "Couldn't read $STDOUT file");
53     { local $/; $actual_stdout = <F> }
54     open F, "< $STDERR" or return (0, "Couldn't read $STDERR file");
55     { local $/; $actual_stderr = <F> }
56
57     if ($actual_stdout ne $stdout) {
58       return (0, "Stdout mismatch: expected [$stdout], saw [$actual_stdout]");
59     } elsif ($actual_stderr ne $stderr) {
60       return (0, "Stderr mismatch: expected [$stderr], saw [$actual_stderr]");
61     } else {
62       return 1;                 # success
63     }
64   } else {                      # child
65     for my $k (keys %$env) {
66       $ENV{$k} = $env->{$k};
67     }
68     open STDOUT, "> $STDOUT" or exit $FAILURE_CODE;
69     open STDERR, "> $STDERR" or it_didnt_work();
70     { exec $PERL, @$args }
71     it_didnt_work();
72   }
73 }
74
75
76 sub it_didnt_work {
77     print STDOUT "IWHCWJIHCI\cNHJWCJQWKJQJWCQW\n";
78     exit $FAILURE_CODE;
79 }
80
81 sub try {
82   my ($success, $reason) = runperl(@_);
83   $reason =~ s/\n/\\n/g if defined $reason;
84   local $::Level = $::Level + 1;
85   ok( $success, $reason );
86 }
87
88 #  PERL5OPT    Command-line options (switches).  Switches in
89 #                    this variable are taken as if they were on
90 #                    every Perl command line.  Only the -[DIMUdmtw]
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
98 try({PERL5OPT => '-w'}, ['-e', 'print $::x'],
99     "", 
100     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});
101
102 try({PERL5OPT => '-Mstrict'}, ['-e', 'print $::x'],
103     "", "");
104
105 try({PERL5OPT => '-Mstrict'}, ['-e', 'print $x'],
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
110 try({PERL5OPT => '-Mstrict -w'}, ['-e', 'print $x'],
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
115 try({PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'],
116     "", 
117     <<ERROR
118 Name "main::x" used only once: possible typo at -e line 1.
119 Use of uninitialized value \$x in print at -e line 1.
120 ERROR
121     );
122
123 # Fails in 5.6.0
124 try({PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'],
125     "", 
126     <<ERROR
127 Name "main::x" used only once: possible typo at -e line 1.
128 Use of uninitialized value \$x in print at -e line 1.
129 ERROR
130     );
131
132 try({PERL5OPT => '-MExporter'}, ['-e0'],
133     "", 
134     "");
135
136 # Fails in 5.6.0
137 try({PERL5OPT => '-MExporter -MExporter'}, ['-e0'],
138     "", 
139     "");
140
141 try({PERL5OPT => '-Mstrict -Mwarnings'}, 
142     ['-e', 'print "ok" if $INC{"strict.pm"} and $INC{"warnings.pm"}'],
143     "ok",
144     "");
145
146 try({PERL5OPT => '-w -w'},
147     ['-e', 'print $ENV{PERL5OPT}'],
148     '-w -w',
149     '');
150
151 try({PERL5OPT => '-t'},
152     ['-e', 'print ${^TAINT}'],
153     '-1',
154     '');
155
156 try({PERLLIB => "foobar$Config{path_sep}42"},
157     ['-e', 'print grep { $_ eq "foobar" } @INC'],
158     'foobar',
159     '');
160
161 try({PERLLIB => "foobar$Config{path_sep}42"},
162     ['-e', 'print grep { $_ eq "42" } @INC'],
163     '42',
164     '');
165
166 try({PERL5LIB => "foobar$Config{path_sep}42"},
167     ['-e', 'print grep { $_ eq "foobar" } @INC'],
168     'foobar',
169     '');
170
171 try({PERL5LIB => "foobar$Config{path_sep}42"},
172     ['-e', 'print grep { $_ eq "42" } @INC'],
173     '42',
174     '');
175
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
188 # PERL5LIB tests with included arch directories still missing
189
190 END {
191     1 while unlink $STDOUT;
192     1 while unlink $STDERR;
193 }