1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate# 3*0Sstevel@tonic-gate# Tests for Perl run-time environment variable settings 4*0Sstevel@tonic-gate# 5*0Sstevel@tonic-gate# $PERL5OPT, $PERL5LIB, etc. 6*0Sstevel@tonic-gate 7*0Sstevel@tonic-gateBEGIN { 8*0Sstevel@tonic-gate chdir 't' if -d 't'; 9*0Sstevel@tonic-gate @INC = '../lib'; 10*0Sstevel@tonic-gate require Config; import Config; 11*0Sstevel@tonic-gate unless ($Config{'d_fork'}) { 12*0Sstevel@tonic-gate print "1..0 # Skip: no fork\n"; 13*0Sstevel@tonic-gate exit 0; 14*0Sstevel@tonic-gate } 15*0Sstevel@tonic-gate} 16*0Sstevel@tonic-gate 17*0Sstevel@tonic-gateuse Test; 18*0Sstevel@tonic-gate 19*0Sstevel@tonic-gateplan tests => 17; 20*0Sstevel@tonic-gate 21*0Sstevel@tonic-gatemy $STDOUT = './results-0'; 22*0Sstevel@tonic-gatemy $STDERR = './results-1'; 23*0Sstevel@tonic-gatemy $PERL = './perl'; 24*0Sstevel@tonic-gatemy $FAILURE_CODE = 119; 25*0Sstevel@tonic-gate 26*0Sstevel@tonic-gatedelete $ENV{PERLLIB}; 27*0Sstevel@tonic-gatedelete $ENV{PERL5LIB}; 28*0Sstevel@tonic-gatedelete $ENV{PERL5OPT}; 29*0Sstevel@tonic-gate 30*0Sstevel@tonic-gate# Run perl with specified environment and arguments returns a list. 31*0Sstevel@tonic-gate# First element is true if Perl's stdout and stderr match the 32*0Sstevel@tonic-gate# supplied $stdout and $stderr argument strings exactly. 33*0Sstevel@tonic-gate# second element is an explanation of the failure 34*0Sstevel@tonic-gatesub runperl { 35*0Sstevel@tonic-gate local *F; 36*0Sstevel@tonic-gate my ($env, $args, $stdout, $stderr) = @_; 37*0Sstevel@tonic-gate 38*0Sstevel@tonic-gate unshift @$args, '-I../lib'; 39*0Sstevel@tonic-gate 40*0Sstevel@tonic-gate $stdout = '' unless defined $stdout; 41*0Sstevel@tonic-gate $stderr = '' unless defined $stderr; 42*0Sstevel@tonic-gate local %ENV = %ENV; 43*0Sstevel@tonic-gate delete $ENV{PERLLIB}; 44*0Sstevel@tonic-gate delete $ENV{PERL5LIB}; 45*0Sstevel@tonic-gate delete $ENV{PERL5OPT}; 46*0Sstevel@tonic-gate my $pid = fork; 47*0Sstevel@tonic-gate return (0, "Couldn't fork: $!") unless defined $pid; # failure 48*0Sstevel@tonic-gate if ($pid) { # parent 49*0Sstevel@tonic-gate my ($actual_stdout, $actual_stderr); 50*0Sstevel@tonic-gate wait; 51*0Sstevel@tonic-gate return (0, "Failure in child.\n") if ($?>>8) == $FAILURE_CODE; 52*0Sstevel@tonic-gate 53*0Sstevel@tonic-gate open F, "< $STDOUT" or return (0, "Couldn't read $STDOUT file"); 54*0Sstevel@tonic-gate { local $/; $actual_stdout = <F> } 55*0Sstevel@tonic-gate open F, "< $STDERR" or return (0, "Couldn't read $STDERR file"); 56*0Sstevel@tonic-gate { local $/; $actual_stderr = <F> } 57*0Sstevel@tonic-gate 58*0Sstevel@tonic-gate if ($actual_stdout ne $stdout) { 59*0Sstevel@tonic-gate return (0, "Stdout mismatch: expected [$stdout], saw [$actual_stdout]"); 60*0Sstevel@tonic-gate } elsif ($actual_stderr ne $stderr) { 61*0Sstevel@tonic-gate return (0, "Stderr mismatch: expected [$stderr], saw [$actual_stderr]"); 62*0Sstevel@tonic-gate } else { 63*0Sstevel@tonic-gate return 1; # success 64*0Sstevel@tonic-gate } 65*0Sstevel@tonic-gate } else { # child 66*0Sstevel@tonic-gate for my $k (keys %$env) { 67*0Sstevel@tonic-gate $ENV{$k} = $env->{$k}; 68*0Sstevel@tonic-gate } 69*0Sstevel@tonic-gate open STDOUT, "> $STDOUT" or exit $FAILURE_CODE; 70*0Sstevel@tonic-gate open STDERR, "> $STDERR" or it_didnt_work(); 71*0Sstevel@tonic-gate { exec $PERL, @$args } 72*0Sstevel@tonic-gate it_didnt_work(); 73*0Sstevel@tonic-gate } 74*0Sstevel@tonic-gate} 75*0Sstevel@tonic-gate 76*0Sstevel@tonic-gate 77*0Sstevel@tonic-gatesub it_didnt_work { 78*0Sstevel@tonic-gate print STDOUT "IWHCWJIHCI\cNHJWCJQWKJQJWCQW\n"; 79*0Sstevel@tonic-gate exit $FAILURE_CODE; 80*0Sstevel@tonic-gate} 81*0Sstevel@tonic-gate 82*0Sstevel@tonic-gatesub try { 83*0Sstevel@tonic-gate my ($success, $reason) = runperl(@_); 84*0Sstevel@tonic-gate $reason =~ s/\n/\\n/g if defined $reason; 85*0Sstevel@tonic-gate ok( !!$success, 1, $reason ); 86*0Sstevel@tonic-gate} 87*0Sstevel@tonic-gate 88*0Sstevel@tonic-gate# PERL5OPT Command-line options (switches). Switches in 89*0Sstevel@tonic-gate# this variable are taken as if they were on 90*0Sstevel@tonic-gate# every Perl command line. Only the -[DIMUdmtw] 91*0Sstevel@tonic-gate# switches are allowed. When running taint 92*0Sstevel@tonic-gate# checks (because the program was running setuid 93*0Sstevel@tonic-gate# or setgid, or the -T switch was used), this 94*0Sstevel@tonic-gate# variable is ignored. If PERL5OPT begins with 95*0Sstevel@tonic-gate# -T, tainting will be enabled, and any 96*0Sstevel@tonic-gate# subsequent options ignored. 97*0Sstevel@tonic-gate 98*0Sstevel@tonic-gatetry({PERL5OPT => '-w'}, ['-e', 'print $::x'], 99*0Sstevel@tonic-gate "", 100*0Sstevel@tonic-gate 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*0Sstevel@tonic-gate 102*0Sstevel@tonic-gatetry({PERL5OPT => '-Mstrict'}, ['-e', 'print $::x'], 103*0Sstevel@tonic-gate "", ""); 104*0Sstevel@tonic-gate 105*0Sstevel@tonic-gatetry({PERL5OPT => '-Mstrict'}, ['-e', 'print $x'], 106*0Sstevel@tonic-gate "", 107*0Sstevel@tonic-gate qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n}); 108*0Sstevel@tonic-gate 109*0Sstevel@tonic-gate# Fails in 5.6.0 110*0Sstevel@tonic-gatetry({PERL5OPT => '-Mstrict -w'}, ['-e', 'print $x'], 111*0Sstevel@tonic-gate "", 112*0Sstevel@tonic-gate qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n}); 113*0Sstevel@tonic-gate 114*0Sstevel@tonic-gate# Fails in 5.6.0 115*0Sstevel@tonic-gatetry({PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'], 116*0Sstevel@tonic-gate "", 117*0Sstevel@tonic-gate <<ERROR 118*0Sstevel@tonic-gateName "main::x" used only once: possible typo at -e line 1. 119*0Sstevel@tonic-gateUse of uninitialized value in print at -e line 1. 120*0Sstevel@tonic-gateERROR 121*0Sstevel@tonic-gate ); 122*0Sstevel@tonic-gate 123*0Sstevel@tonic-gate# Fails in 5.6.0 124*0Sstevel@tonic-gatetry({PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'], 125*0Sstevel@tonic-gate "", 126*0Sstevel@tonic-gate <<ERROR 127*0Sstevel@tonic-gateName "main::x" used only once: possible typo at -e line 1. 128*0Sstevel@tonic-gateUse of uninitialized value in print at -e line 1. 129*0Sstevel@tonic-gateERROR 130*0Sstevel@tonic-gate ); 131*0Sstevel@tonic-gate 132*0Sstevel@tonic-gatetry({PERL5OPT => '-MExporter'}, ['-e0'], 133*0Sstevel@tonic-gate "", 134*0Sstevel@tonic-gate ""); 135*0Sstevel@tonic-gate 136*0Sstevel@tonic-gate# Fails in 5.6.0 137*0Sstevel@tonic-gatetry({PERL5OPT => '-MExporter -MExporter'}, ['-e0'], 138*0Sstevel@tonic-gate "", 139*0Sstevel@tonic-gate ""); 140*0Sstevel@tonic-gate 141*0Sstevel@tonic-gatetry({PERL5OPT => '-Mstrict -Mwarnings'}, 142*0Sstevel@tonic-gate ['-e', 'print "ok" if $INC{"strict.pm"} and $INC{"warnings.pm"}'], 143*0Sstevel@tonic-gate "ok", 144*0Sstevel@tonic-gate ""); 145*0Sstevel@tonic-gate 146*0Sstevel@tonic-gatetry({PERL5OPT => '-w -w'}, 147*0Sstevel@tonic-gate ['-e', 'print $ENV{PERL5OPT}'], 148*0Sstevel@tonic-gate '-w -w', 149*0Sstevel@tonic-gate ''); 150*0Sstevel@tonic-gate 151*0Sstevel@tonic-gatetry({PERL5OPT => '-t'}, 152*0Sstevel@tonic-gate ['-e', 'print ${^TAINT}'], 153*0Sstevel@tonic-gate '-1', 154*0Sstevel@tonic-gate ''); 155*0Sstevel@tonic-gate 156*0Sstevel@tonic-gatetry({PERLLIB => "foobar$Config{path_sep}42"}, 157*0Sstevel@tonic-gate ['-e', 'print grep { $_ eq "foobar" } @INC'], 158*0Sstevel@tonic-gate 'foobar', 159*0Sstevel@tonic-gate ''); 160*0Sstevel@tonic-gate 161*0Sstevel@tonic-gatetry({PERLLIB => "foobar$Config{path_sep}42"}, 162*0Sstevel@tonic-gate ['-e', 'print grep { $_ eq "42" } @INC'], 163*0Sstevel@tonic-gate '42', 164*0Sstevel@tonic-gate ''); 165*0Sstevel@tonic-gate 166*0Sstevel@tonic-gatetry({PERL5LIB => "foobar$Config{path_sep}42"}, 167*0Sstevel@tonic-gate ['-e', 'print grep { $_ eq "foobar" } @INC'], 168*0Sstevel@tonic-gate 'foobar', 169*0Sstevel@tonic-gate ''); 170*0Sstevel@tonic-gate 171*0Sstevel@tonic-gatetry({PERL5LIB => "foobar$Config{path_sep}42"}, 172*0Sstevel@tonic-gate ['-e', 'print grep { $_ eq "42" } @INC'], 173*0Sstevel@tonic-gate '42', 174*0Sstevel@tonic-gate ''); 175*0Sstevel@tonic-gate 176*0Sstevel@tonic-gatetry({PERL5LIB => "foo", 177*0Sstevel@tonic-gate PERLLIB => "bar"}, 178*0Sstevel@tonic-gate ['-e', 'print grep { $_ eq "foo" } @INC'], 179*0Sstevel@tonic-gate 'foo', 180*0Sstevel@tonic-gate ''); 181*0Sstevel@tonic-gate 182*0Sstevel@tonic-gatetry({PERL5LIB => "foo", 183*0Sstevel@tonic-gate PERLLIB => "bar"}, 184*0Sstevel@tonic-gate ['-e', 'print grep { $_ eq "bar" } @INC'], 185*0Sstevel@tonic-gate '', 186*0Sstevel@tonic-gate ''); 187*0Sstevel@tonic-gate 188*0Sstevel@tonic-gate# PERL5LIB tests with included arch directories still missing 189*0Sstevel@tonic-gate 190*0Sstevel@tonic-gateEND { 191*0Sstevel@tonic-gate 1 while unlink $STDOUT; 192*0Sstevel@tonic-gate 1 while unlink $STDERR; 193*0Sstevel@tonic-gate} 194