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