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