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