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 }
  16
  17 use Test;
  18
  19 plan tests => 10;
  20
  21 my $STDOUT = './results-0';
  22 my $STDERR = './results-1';
  23 my $PERL = './perl';
  24 my $FAILURE_CODE = 119;
  25
  26 # Run perl with specified environment and arguments returns a list.
  27 # First element is true iff Perl's stdout and stderr match the
  28 # supplied $stdout and $stderr argument strings exactly.
  29 # second element is an explanation of the failure
  30 sub runperl {
  31   local *F;
  32   my ($env, $args, $stdout, $stderr) = @_;
  33
  34   unshift @$args, '-I../lib';
  35
  36   $stdout = '' unless defined $stdout;
  37   $stderr = '' unless defined $stderr;
  38   my $pid = fork;
  39   return (0, "Couldn't fork: $!") unless defined $pid;   # failure
  40   if ($pid) {                   # parent
  41     my ($actual_stdout, $actual_stderr);
  42     wait;
  43     return (0, "Failure in child.\n") if ($?>>8) == $FAILURE_CODE;
  44
  45     open F, "< $STDOUT" or return (0, "Couldn't read $STDOUT file");
  46     { local $/; $actual_stdout = <F> }
  47     open F, "< $STDERR" or return (0, "Couldn't read $STDERR file");
  48     { local $/; $actual_stderr = <F> }
  49
  50     if ($actual_stdout ne $stdout) {
  51       return (0, "Stdout mismatch: expected [$stdout], saw [$actual_stdout]");
  52     } elsif ($actual_stderr ne $stderr) {
  53       return (0, "Stderr mismatch: expected [$stderr], saw [$actual_stderr]");
  54     } else {
  55       return 1;                 # success
  56     }
  57   } else {                      # child
  58     for my $k (keys %$env) {
  59       $ENV{$k} = $env->{$k};
  60     }
  61     open STDOUT, "> $STDOUT" or exit $FAILURE_CODE;
  62     open STDERR, "> $STDERR" or it_didnt_work();
  63     { exec $PERL, @$args }
  64     it_didnt_work();
  65   }
  66 }
  67
  68
  69 sub it_didnt_work {
  70     print STDOUT "IWHCWJIHCI\cNHJWCJQWKJQJWCQW\n";
  71     exit $FAILURE_CODE;
  72 }
  73
  74 sub try {
  75   my ($success, $reason) = runperl(@_);
  76   $reason =~ s/\n/\\n/g if defined $reason;
  77   ok( !!$success, 1, $reason );
  78 }
  79
  80 #  PERL5OPT    Command-line options (switches).  Switches in
  81 #                    this variable are taken as if they were on
  82 #                    every Perl command line.  Only the -[DIMUdmw]
  83 #                    switches are allowed.  When running taint
  84 #                    checks (because the program was running setuid
  85 #                    or setgid, or the -T switch was used), this
  86 #                    variable is ignored.  If PERL5OPT begins with
  87 #                    -T, tainting will be enabled, and any
  88 #                    subsequent options ignored.
  89
  90 try({PERL5OPT => '-w'}, ['-e', 'print $::x'],
  91     "",
  92     qq{Name "main::x" used only once: possible typo at -e line 1.\nUse of uninitialized value in print at -e line 1.\n});
  93
  94 try({PERL5OPT => '-Mstrict'}, ['-e', 'print $::x'],
  95     "", "");
  96
  97 try({PERL5OPT => '-Mstrict'}, ['-e', 'print $x'],
  98     "",
  99     qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n});
 100
 101 # Fails in 5.6.0
 102 try({PERL5OPT => '-Mstrict -w'}, ['-e', 'print $x'],
 103     "",
 104     qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n});
 105
 106 # Fails in 5.6.0
 107 try({PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'],
 108     "",
 109     <<ERROR
 110 Name "main::x" used only once: possible typo at -e line 1.
 111 Use of uninitialized value in print at -e line 1.
 112 ERROR
 113     );
 114
 115 # Fails in 5.6.0
 116 try({PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'],
 117     "",
 118     <<ERROR
 119 Name "main::x" used only once: possible typo at -e line 1.
 120 Use of uninitialized value in print at -e line 1.
 121 ERROR
 122     );
 123
 124 try({PERL5OPT => '-MExporter'}, ['-e0'],
 125     "",
 126     "");
 127
 128 # Fails in 5.6.0
 129 try({PERL5OPT => '-MExporter -MExporter'}, ['-e0'],
 130     "",
 131     "");
 132
 133 try({PERL5OPT => '-Mstrict -Mwarnings'},
 134     ['-e', 'print "ok" if $INC{"strict.pm"} and $INC{"warnings.pm"}'],
 135     "ok",
 136     "");
 137
 138 try({PERL5OPT => '-w -w'},
 139     ['-e', 'print $ENV{PERL5OPT}'],
 140     '-w -w',
 141     '');
 142
 143 END {
 144     1 while unlink $STDOUT;
 145     1 while unlink $STDERR;
 146 }