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