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