1#!./perl 2# 3# Tests for Perl run-time environment variable settings 4# 5# $PERL5OPT, $PERL5LIB, etc. 6 7BEGIN { 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 17use Test; 18 19plan tests => 17; 20 21my $STDOUT = './results-0'; 22my $STDERR = './results-1'; 23my $PERL = './perl'; 24my $FAILURE_CODE = 119; 25 26delete $ENV{PERLLIB}; 27delete $ENV{PERL5LIB}; 28delete $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 34sub 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 local %ENV = %ENV; 43 delete $ENV{PERLLIB}; 44 delete $ENV{PERL5LIB}; 45 delete $ENV{PERL5OPT}; 46 my $pid = fork; 47 return (0, "Couldn't fork: $!") unless defined $pid; # failure 48 if ($pid) { # parent 49 my ($actual_stdout, $actual_stderr); 50 wait; 51 return (0, "Failure in child.\n") if ($?>>8) == $FAILURE_CODE; 52 53 open F, "< $STDOUT" or return (0, "Couldn't read $STDOUT file"); 54 { local $/; $actual_stdout = <F> } 55 open F, "< $STDERR" or return (0, "Couldn't read $STDERR file"); 56 { local $/; $actual_stderr = <F> } 57 58 if ($actual_stdout ne $stdout) { 59 return (0, "Stdout mismatch: expected [$stdout], saw [$actual_stdout]"); 60 } elsif ($actual_stderr ne $stderr) { 61 return (0, "Stderr mismatch: expected [$stderr], saw [$actual_stderr]"); 62 } else { 63 return 1; # success 64 } 65 } else { # child 66 for my $k (keys %$env) { 67 $ENV{$k} = $env->{$k}; 68 } 69 open STDOUT, "> $STDOUT" or exit $FAILURE_CODE; 70 open STDERR, "> $STDERR" or it_didnt_work(); 71 { exec $PERL, @$args } 72 it_didnt_work(); 73 } 74} 75 76 77sub it_didnt_work { 78 print STDOUT "IWHCWJIHCI\cNHJWCJQWKJQJWCQW\n"; 79 exit $FAILURE_CODE; 80} 81 82sub try { 83 my ($success, $reason) = runperl(@_); 84 $reason =~ s/\n/\\n/g if defined $reason; 85 ok( !!$success, 1, $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 98try({PERL5OPT => '-w'}, ['-e', 'print $::x'], 99 "", 100 qq{Name "main::x" used only once: possible typo at -e line 1.\nUse of uninitialized value in print at -e line 1.\n}); 101 102try({PERL5OPT => '-Mstrict'}, ['-e', 'print $::x'], 103 "", ""); 104 105try({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 110try({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 115try({PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'], 116 "", 117 <<ERROR 118Name "main::x" used only once: possible typo at -e line 1. 119Use of uninitialized value in print at -e line 1. 120ERROR 121 ); 122 123# Fails in 5.6.0 124try({PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'], 125 "", 126 <<ERROR 127Name "main::x" used only once: possible typo at -e line 1. 128Use of uninitialized value in print at -e line 1. 129ERROR 130 ); 131 132try({PERL5OPT => '-MExporter'}, ['-e0'], 133 "", 134 ""); 135 136# Fails in 5.6.0 137try({PERL5OPT => '-MExporter -MExporter'}, ['-e0'], 138 "", 139 ""); 140 141try({PERL5OPT => '-Mstrict -Mwarnings'}, 142 ['-e', 'print "ok" if $INC{"strict.pm"} and $INC{"warnings.pm"}'], 143 "ok", 144 ""); 145 146try({PERL5OPT => '-w -w'}, 147 ['-e', 'print $ENV{PERL5OPT}'], 148 '-w -w', 149 ''); 150 151try({PERL5OPT => '-t'}, 152 ['-e', 'print ${^TAINT}'], 153 '-1', 154 ''); 155 156try({PERLLIB => "foobar$Config{path_sep}42"}, 157 ['-e', 'print grep { $_ eq "foobar" } @INC'], 158 'foobar', 159 ''); 160 161try({PERLLIB => "foobar$Config{path_sep}42"}, 162 ['-e', 'print grep { $_ eq "42" } @INC'], 163 '42', 164 ''); 165 166try({PERL5LIB => "foobar$Config{path_sep}42"}, 167 ['-e', 'print grep { $_ eq "foobar" } @INC'], 168 'foobar', 169 ''); 170 171try({PERL5LIB => "foobar$Config{path_sep}42"}, 172 ['-e', 'print grep { $_ eq "42" } @INC'], 173 '42', 174 ''); 175 176try({PERL5LIB => "foo", 177 PERLLIB => "bar"}, 178 ['-e', 'print grep { $_ eq "foo" } @INC'], 179 'foo', 180 ''); 181 182try({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 190END { 191 1 while unlink $STDOUT; 192 1 while unlink $STDERR; 193} 194