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