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