This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fixes to allow win32 Perl to properly handle PERL5LIB.
[perl5.git] / t / win32 / runenv.t
1 #!./perl
2 #
3 # Tests for Perl run-time environment variable settings
4 # Clone of t/run/runenv.t but without the forking, and with cmd.exe-friendly -e syntax.
5 #
6 # $PERL5OPT, $PERL5LIB, etc.
7
8 BEGIN {
9     chdir 't' if -d 't';
10     @INC = '../lib';
11     require Config; import Config;
12     require File::Temp; import File::Temp qw/:POSIX/;
13
14     require Win32;
15     ($::os_id, $::os_major) = ( Win32::GetOSVersion() )[ 4, 1 ];
16     if ($::os_id == 2 and $::os_major == 6) {    # Vista, Server 2008 (incl R2), 7
17         $::tests = 43;
18     }
19     else {
20         $::tests = 42;
21     }
22
23     require './test.pl';
24 }
25
26 plan tests => $::tests;
27
28 my $PERL = $ENV{PERL} || '.\perl';
29 my $NL = $/;
30
31 delete $ENV{PERLLIB};
32 delete $ENV{PERL5LIB};
33 delete $ENV{PERL5OPT};
34
35
36 # Run perl with specified environment and arguments, return (STDOUT, STDERR)
37 sub runperl_and_capture {
38   my ($env, $args) = @_;
39
40   # Clear out old env
41   local %ENV = %ENV;
42   delete $ENV{PERLLIB};
43   delete $ENV{PERL5LIB};
44   delete $ENV{PERL5OPT};
45
46   # Populate with our desired env
47   for my $k (keys %$env) {
48      $ENV{$k} = $env->{$k};
49   }
50
51   # This is slightly expensive, but this is more reliable than
52   # trying to emulate fork(), and we still get STDERR and STDOUT individually.
53   my $stderr_cache = tmpnam();
54   my $stdout = `$PERL @$args 2>$stderr_cache`;
55   my $stderr = '';
56   if (-s $stderr_cache) {
57     open(my $stderr_cache_fh, "<", $stderr_cache)
58       or die "Could not retrieve STDERR output: $!";
59     while ( defined(my $s_line = <$stderr_cache_fh>) ) {
60       $stderr .= $s_line;
61     }
62     close $stderr_cache_fh;
63     unlink $stderr_cache;
64   }
65   
66   return ($stdout, $stderr);
67 }
68
69 sub try {
70   my ($env, $args, $stdout, $stderr) = @_;
71   my ($actual_stdout, $actual_stderr) = runperl_and_capture($env, $args);
72   local $::Level = $::Level + 1;
73   is ($stdout, $actual_stdout);
74   is ($stderr, $actual_stderr);
75 }
76
77 #  PERL5OPT    Command-line options (switches).  Switches in
78 #                    this variable are taken as if they were on
79 #                    every Perl command line.  Only the -[DIMUdmtw]
80 #                    switches are allowed.  When running taint
81 #                    checks (because the program was running setuid
82 #                    or setgid, or the -T switch was used), this
83 #                    variable is ignored.  If PERL5OPT begins with
84 #                    -T, tainting will be enabled, and any
85 #                    subsequent options ignored.
86
87 try({PERL5OPT => '-w'}, ['-e', '"print $::x"'],
88     "", 
89     qq(Name "main::x" used only once: possible typo at -e line 1.${NL}Use of uninitialized value \$x in print at -e line 1.${NL}));
90
91 try({PERL5OPT => '-Mstrict'}, ['-I..\lib', '-e', '"print $::x"'],
92     "", "");
93
94 try({PERL5OPT => '-Mstrict'}, ['-I..\lib', '-e', '"print $x"'],
95     "", 
96     qq(Global symbol "\$x" requires explicit package name at -e line 1.${NL}Execution of -e aborted due to compilation errors.${NL}));
97
98 # Fails in 5.6.0
99 try({PERL5OPT => '-Mstrict -w'}, ['-I..\lib', '-e', '"print $x"'],
100     "", 
101     qq(Global symbol "\$x" requires explicit package name at -e line 1.${NL}Execution of -e aborted due to compilation errors.${NL}));
102
103 # Fails in 5.6.0
104 try({PERL5OPT => '-w -Mstrict'}, ['-I..\lib', '-e', '"print $::x"'],
105     "", 
106     <<ERROR
107 Name "main::x" used only once: possible typo at -e line 1.
108 Use of uninitialized value \$x in print at -e line 1.
109 ERROR
110     );
111
112 # Fails in 5.6.0
113 try({PERL5OPT => '-w -Mstrict'}, ['-I..\lib', '-e', '"print $::x"'],
114     "", 
115     <<ERROR
116 Name "main::x" used only once: possible typo at -e line 1.
117 Use of uninitialized value \$x in print at -e line 1.
118 ERROR
119     );
120
121 try({PERL5OPT => '-MExporter'}, ['-I..\lib', '-e0'],
122     "", 
123     "");
124
125 # Fails in 5.6.0
126 try({PERL5OPT => '-MExporter -MExporter'}, ['-I..\lib', '-e0'],
127     "", 
128     "");
129
130 try({PERL5OPT => '-Mstrict -Mwarnings'}, 
131     ['-I..\lib', '-e', '"print \"ok\" if $INC{\"strict.pm\"} and $INC{\"warnings.pm\"}"'],
132     "ok",
133     "");
134
135 open my $fh, ">", "Oooof.pm" or die "Can't write Oooof.pm: $!";
136 print $fh "package Oooof; 1;\n";
137 close $fh;
138 END { 1 while unlink "Oooof.pm" }
139
140 try({PERL5OPT => '-I. -MOooof'}, 
141     ['-e', '"print \"ok\" if $INC{\"Oooof.pm\"} eq \"Oooof.pm\""'],
142     "ok",
143     "");
144
145 try({PERL5OPT => '-w -w'},
146     ['-e', '"print $ENV{PERL5OPT}"'],
147     '-w -w',
148     '');
149
150 try({PERL5OPT => '-t'},
151     ['-e', '"print ${^TAINT}"'],
152     '-1',
153     '');
154
155 try({PERL5OPT => '-W'},
156     ['-I..\lib','-e', '"local $^W = 0;  no warnings;  print $x"'],
157     '',
158     <<ERROR
159 Name "main::x" used only once: possible typo at -e line 1.
160 Use of uninitialized value \$x in print at -e line 1.
161 ERROR
162 );
163
164 try({PERLLIB => "foobar$Config{path_sep}42"},
165     ['-e', '"print grep { $_ eq \"foobar\" } @INC"'],
166     'foobar',
167     '');
168
169 try({PERLLIB => "foobar$Config{path_sep}42"},
170     ['-e', '"print grep { $_ eq \"42\" } @INC"'],
171     '42',
172     '');
173
174 try({PERL5LIB => "foobar$Config{path_sep}42"},
175     ['-e', '"print grep { $_ eq \"foobar\" } @INC"'],
176     'foobar',
177     '');
178
179 try({PERL5LIB => "foobar$Config{path_sep}42"},
180     ['-e', '"print grep { $_ eq \"42\" } @INC"'],
181     '42',
182     '');
183
184 try({PERL5LIB => "foo",
185      PERLLIB => "bar"},
186     ['-e', '"print grep { $_ eq \"foo\" } @INC"'],
187     'foo',
188     '');
189
190 try({PERL5LIB => "foo",
191      PERLLIB => "bar"},
192     ['-e', '"print grep { $_ eq \"bar\" } @INC"'],
193     '',
194     '');
195
196 # Tests for S_incpush_use_sep():
197
198 my @dump_inc = ('-e', '"print \"$_\n\" foreach @INC"');
199
200 my ($out, $err) = runperl_and_capture({}, [@dump_inc]);
201
202 is ($err, '', 'No errors when determining @INC');
203
204 my @default_inc = split /\n/, $out;
205
206 is ($default_inc[-1], '.', '. is last in @INC');
207
208 my $sep = $Config{path_sep};
209 my @test_cases = (
210          ['nothing', ''],
211          ['something', 'zwapp', 'zwapp'],
212          ['two things', "zwapp${sep}bam", 'zwapp', 'bam'],
213          ['two things, ::', "zwapp${sep}${sep}bam", 'zwapp', 'bam'],
214          [': at start', "${sep}zwapp", 'zwapp'],
215          [': at end', "zwapp${sep}", 'zwapp'],
216          [':: sandwich ::', "${sep}${sep}zwapp${sep}${sep}", 'zwapp'],
217          [':', "${sep}"],
218          ['::', "${sep}${sep}"],
219          [':::', "${sep}${sep}${sep}"],
220          ['two things and :', "zwapp${sep}bam${sep}", 'zwapp', 'bam'],
221          [': and two things', "${sep}zwapp${sep}bam", 'zwapp', 'bam'],
222          [': two things :', "${sep}zwapp${sep}bam${sep}", 'zwapp', 'bam'],
223          ['three things', "zwapp${sep}bam${sep}${sep}owww",
224           'zwapp', 'bam', 'owww'],
225 );
226
227 # This block added to verify fix for RT #87322
228 if ($::os_id == 2 and $::os_major == 6) {    # Vista, Server 2008 (incl R2), 7
229   my @big_perl5lib = ('z' x 16) x 2049;
230     push @testcases, [
231         'enough items so PERL5LIB val is longer than 32k',
232         join($sep, @big_perl5lib), @big_perl5lib,
233     ];
234 }
235
236 foreach ( @testcases ) {
237   my ($name, $lib, @expect) = @$_;
238   push @expect, @default_inc;
239
240   ($out, $err) = runperl_and_capture({PERL5LIB => $lib}, [@dump_inc]);
241
242   is ($err, '', "No errors when determining \@INC for $name");
243
244   my @inc = split /\n/, $out;
245
246   is (scalar @inc, scalar @expect,
247       "expected number of elements in \@INC for $name");
248
249   is ("@inc", "@expect", "expected elements in \@INC for $name");
250 }