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