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 => 78;
  19
  20 my $STDOUT = tempfile();
  21 my $STDERR = tempfile();
  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
  30 sub runperl_and_capture {
  31   local *F;
  32   my ($env, $args) = @_;
  33   unshift @$args, '-I../lib';
  34
  35   local %ENV = %ENV;
  36   delete $ENV{PERLLIB};
  37   delete $ENV{PERL5LIB};
  38   delete $ENV{PERL5OPT};
  39   my $pid = fork;
  40   return (0, "Couldn't fork: $!") unless defined $pid;   # failure
  41   if ($pid) {                   # parent
  42     my ($actual_stdout, $actual_stderr);
  43     wait;
  44     return (0, "Failure in child.\n") if ($?>>8) == $FAILURE_CODE;
  45
  46     open F, "< $STDOUT" or return (0, "Couldn't read $STDOUT file");
  47     { local $/; $actual_stdout = <F> }
  48     open F, "< $STDERR" or return (0, "Couldn't read $STDERR file");
  49     { local $/; $actual_stderr = <F> }
  50
  51     return ($actual_stdout, $actual_stderr);
  52   } else {                      # child
  53     for my $k (keys %$env) {
  54       $ENV{$k} = $env->{$k};
  55     }
  56     open STDOUT, "> $STDOUT" or exit $FAILURE_CODE;
  57     open STDERR, "> $STDERR" or it_didnt_work();
  58     { exec $PERL, @$args }
  59     it_didnt_work();
  60   }
  61 }
  62
  63 # Run perl with specified environment and arguments returns a list.
  64 # First element is true if Perl's stdout and stderr match the
  65 # supplied $stdout and $stderr argument strings exactly.
  66 # second element is an explanation of the failure
  67 sub runperl {
  68   local *F;
  69   my ($env, $args, $stdout, $stderr) = @_;
  70   my ($actual_stdout, $actual_stderr) = runperl_and_capture($env, $args);
  71   if ($actual_stdout ne $stdout) {
  72     return (0, "Stdout mismatch: expected [$stdout], saw [$actual_stdout]");
  73   } elsif ($actual_stderr ne $stderr) {
  74     return (0, "Stderr mismatch: expected [$stderr], saw [$actual_stderr]");
  75   } else {
  76     return 1;                 # success
  77   }
  78 }
  79
  80 sub it_didnt_work {
  81     print STDOUT "IWHCWJIHCI\cNHJWCJQWKJQJWCQW\n";
  82     exit $FAILURE_CODE;
  83 }
  84
  85 sub try {
  86   my ($success, $reason) = runperl(@_);
  87   $reason =~ s/\n/\\n/g if defined $reason;
  88   local $::Level = $::Level + 1;
  89   ok( $success, $reason );
  90 }
  91
  92 #  PERL5OPT    Command-line options (switches).  Switches in
  93 #                    this variable are taken as if they were on
  94 #                    every Perl command line.  Only the -[DIMUdmtw]
  95 #                    switches are allowed.  When running taint
  96 #                    checks (because the program was running setuid
  97 #                    or setgid, or the -T switch was used), this
  98 #                    variable is ignored.  If PERL5OPT begins with
  99 #                    -T, tainting will be enabled, and any
 100 #                    subsequent options ignored.
 101
 102 try({PERL5OPT => '-w'}, ['-e', 'print $::x'],
 103     "",
 104     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});
 105
 106 try({PERL5OPT => '-Mstrict'}, ['-e', 'print $::x'],
 107     "", "");
 108
 109 try({PERL5OPT => '-Mstrict'}, ['-e', 'print $x'],
 110     "",
 111     qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n});
 112
 113 # Fails in 5.6.0
 114 try({PERL5OPT => '-Mstrict -w'}, ['-e', 'print $x'],
 115     "",
 116     qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n});
 117
 118 # Fails in 5.6.0
 119 try({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 \$x in print at -e line 1.
 124 ERROR
 125     );
 126
 127 # Fails in 5.6.0
 128 try({PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'],
 129     "",
 130     <<ERROR
 131 Name "main::x" used only once: possible typo at -e line 1.
 132 Use of uninitialized value \$x in print at -e line 1.
 133 ERROR
 134     );
 135
 136 try({PERL5OPT => '-MExporter'}, ['-e0'],
 137     "",
 138     "");
 139
 140 # Fails in 5.6.0
 141 try({PERL5OPT => '-MExporter -MExporter'}, ['-e0'],
 142     "",
 143     "");
 144
 145 try({PERL5OPT => '-Mstrict -Mwarnings'},
 146     ['-e', 'print "ok" if $INC{"strict.pm"} and $INC{"warnings.pm"}'],
 147     "ok",
 148     "");
 149
 150 open F, ">", "Oooof.pm" or die "Can't write Oooof.pm: $!";
 151 print F "package Oooof; 1;\n";
 152 close F;
 153 END { 1 while unlink "Oooof.pm" }
 154
 155 try({PERL5OPT => '-I. -MOooof'},
 156     ['-e', 'print "ok" if $INC{"Oooof.pm"} eq "Oooof.pm"'],
 157     "ok",
 158     "");
 159
 160 try({PERL5OPT => '-I./ -MOooof'},
 161     ['-e', 'print "ok" if $INC{"Oooof.pm"} eq "Oooof.pm"'],
 162     "ok",
 163     "");
 164
 165 try({PERL5OPT => '-w -w'},
 166     ['-e', 'print $ENV{PERL5OPT}'],
 167     '-w -w',
 168     '');
 169
 170 try({PERL5OPT => '-t'},
 171     ['-e', 'print ${^TAINT}'],
 172     '-1',
 173     '');
 174
 175 try({PERL5OPT => '-W'},
 176     ['-e', 'local $^W = 0;  no warnings;  print $x'],
 177     '',
 178     <<ERROR
 179 Name "main::x" used only once: possible typo at -e line 1.
 180 Use of uninitialized value \$x in print at -e line 1.
 181 ERROR
 182 );
 183
 184 try({PERLLIB => "foobar$Config{path_sep}42"},
 185     ['-e', 'print grep { $_ eq "foobar" } @INC'],
 186     'foobar',
 187     '');
 188
 189 try({PERLLIB => "foobar$Config{path_sep}42"},
 190     ['-e', 'print grep { $_ eq "42" } @INC'],
 191     '42',
 192     '');
 193
 194 try({PERL5LIB => "foobar$Config{path_sep}42"},
 195     ['-e', 'print grep { $_ eq "foobar" } @INC'],
 196     'foobar',
 197     '');
 198
 199 try({PERL5LIB => "foobar$Config{path_sep}42"},
 200     ['-e', 'print grep { $_ eq "42" } @INC'],
 201     '42',
 202     '');
 203
 204 try({PERL5LIB => "foo",
 205      PERLLIB => "bar"},
 206     ['-e', 'print grep { $_ eq "foo" } @INC'],
 207     'foo',
 208     '');
 209
 210 try({PERL5LIB => "foo",
 211      PERLLIB => "bar"},
 212     ['-e', 'print grep { $_ eq "bar" } @INC'],
 213     '',
 214     '');
 215
 216 # Tests for S_incpush_use_sep():
 217
 218 my @dump_inc = ('-e', 'print "$_\n" foreach @INC');
 219
 220 my ($out, $err) = runperl_and_capture({}, [@dump_inc]);
 221
 222 is ($err, '', 'No errors when determining @INC');
 223
 224 my @default_inc = split /\n/, $out;
 225
 226 is (shift @default_inc, '../lib', 'Our -I../lib is at the front');
 227
 228 my $sep = $Config{path_sep};
 229 foreach (['nothing', ''],
 230          ['something', 'zwapp', 'zwapp'],
 231          ['two things', "zwapp${sep}bam", 'zwapp', 'bam'],
 232          ['two things, ::', "zwapp${sep}${sep}bam", 'zwapp', 'bam'],
 233          [': at start', "${sep}zwapp", 'zwapp'],
 234          [': at end', "zwapp${sep}", 'zwapp'],
 235          [':: sandwich ::', "${sep}${sep}zwapp${sep}${sep}", 'zwapp'],
 236          [':', "${sep}"],
 237          ['::', "${sep}${sep}"],
 238          [':::', "${sep}${sep}${sep}"],
 239          ['two things and :', "zwapp${sep}bam${sep}", 'zwapp', 'bam'],
 240          [': and two things', "${sep}zwapp${sep}bam", 'zwapp', 'bam'],
 241          [': two things :', "${sep}zwapp${sep}bam${sep}", 'zwapp', 'bam'],
 242          ['three things', "zwapp${sep}bam${sep}${sep}owww",
 243           'zwapp', 'bam', 'owww'],
 244         ) {
 245   my ($name, $lib, @expect) = @$_;
 246   push @expect, @default_inc;
 247
 248   ($out, $err) = runperl_and_capture({PERL5LIB => $lib}, [@dump_inc]);
 249
 250   is ($err, '', "No errors when determining \@INC for $name");
 251
 252   my @inc = split /\n/, $out;
 253
 254   is (shift @inc, '../lib', 'Our -I../lib is at the front for $name');
 255
 256   is (scalar @inc, scalar @expect,
 257       "expected number of elements in \@INC for $name");
 258
 259   is ("@inc", "@expect", "expected elements in \@INC for $name");
 260 }
 261
 262 # PERL5LIB tests with included arch directories still missing
 263
 264 END {
 265     1 while unlink $STDOUT;
 266     1 while unlink $STDERR;
 267 }