--- /dev/null
+#!./perl
+#
+# Tests for Perl run-time environment variable settings
+# Clone of t/run/runenv.t but without the forking, and with cmd.exe-friendly -e syntax.
+#
+# $PERL5OPT, $PERL5LIB, etc.
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require Config; import Config;
+ require File::Temp; import File::Temp qw/:POSIX/;
+
+ require Win32;
+ ($::os_id, $::os_major) = ( Win32::GetOSVersion() )[ 4, 1 ];
+ if ($::os_id == 2 and $::os_major == 6) { # Vista, Server 2008 (incl R2), 7
+ $::tests = 43;
+ }
+ else {
+ $::tests = 42;
+ }
+
+ require './test.pl';
+}
+
+plan tests => $::tests;
+
+my $PERL = $ENV{PERL} || '.\perl';
+my $NL = $/;
+
+delete $ENV{PERLLIB};
+delete $ENV{PERL5LIB};
+delete $ENV{PERL5OPT};
+
+
+# Run perl with specified environment and arguments, return (STDOUT, STDERR)
+sub runperl_and_capture {
+ my ($env, $args) = @_;
+
+ # Clear out old env
+ local %ENV = %ENV;
+ delete $ENV{PERLLIB};
+ delete $ENV{PERL5LIB};
+ delete $ENV{PERL5OPT};
+
+ # Populate with our desired env
+ for my $k (keys %$env) {
+ $ENV{$k} = $env->{$k};
+ }
+
+ # This is slightly expensive, but this is more reliable than
+ # trying to emulate fork(), and we still get STDERR and STDOUT individually.
+ my $stderr_cache = tmpnam();
+ my $stdout = `$PERL @$args 2>$stderr_cache`;
+ my $stderr = '';
+ if (-s $stderr_cache) {
+ open(my $stderr_cache_fh, "<", $stderr_cache)
+ or die "Could not retrieve STDERR output: $!";
+ while ( defined(my $s_line = <$stderr_cache_fh>) ) {
+ $stderr .= $s_line;
+ }
+ close $stderr_cache_fh;
+ unlink $stderr_cache;
+ }
+
+ return ($stdout, $stderr);
+}
+
+sub try {
+ my ($env, $args, $stdout, $stderr) = @_;
+ my ($actual_stdout, $actual_stderr) = runperl_and_capture($env, $args);
+ local $::Level = $::Level + 1;
+ is ($stdout, $actual_stdout);
+ is ($stderr, $actual_stderr);
+}
+
+# PERL5OPT Command-line options (switches). Switches in
+# this variable are taken as if they were on
+# every Perl command line. Only the -[DIMUdmtw]
+# switches are allowed. When running taint
+# checks (because the program was running setuid
+# or setgid, or the -T switch was used), this
+# variable is ignored. If PERL5OPT begins with
+# -T, tainting will be enabled, and any
+# subsequent options ignored.
+
+try({PERL5OPT => '-w'}, ['-e', '"print $::x"'],
+ "",
+ qq(Name "main::x" used only once: possible typo at -e line 1.${NL}Use of uninitialized value \$x in print at -e line 1.${NL}));
+
+try({PERL5OPT => '-Mstrict'}, ['-I..\lib', '-e', '"print $::x"'],
+ "", "");
+
+try({PERL5OPT => '-Mstrict'}, ['-I..\lib', '-e', '"print $x"'],
+ "",
+ qq(Global symbol "\$x" requires explicit package name at -e line 1.${NL}Execution of -e aborted due to compilation errors.${NL}));
+
+# Fails in 5.6.0
+try({PERL5OPT => '-Mstrict -w'}, ['-I..\lib', '-e', '"print $x"'],
+ "",
+ qq(Global symbol "\$x" requires explicit package name at -e line 1.${NL}Execution of -e aborted due to compilation errors.${NL}));
+
+# Fails in 5.6.0
+try({PERL5OPT => '-w -Mstrict'}, ['-I..\lib', '-e', '"print $::x"'],
+ "",
+ <<ERROR
+Name "main::x" used only once: possible typo at -e line 1.
+Use of uninitialized value \$x in print at -e line 1.
+ERROR
+ );
+
+# Fails in 5.6.0
+try({PERL5OPT => '-w -Mstrict'}, ['-I..\lib', '-e', '"print $::x"'],
+ "",
+ <<ERROR
+Name "main::x" used only once: possible typo at -e line 1.
+Use of uninitialized value \$x in print at -e line 1.
+ERROR
+ );
+
+try({PERL5OPT => '-MExporter'}, ['-I..\lib', '-e0'],
+ "",
+ "");
+
+# Fails in 5.6.0
+try({PERL5OPT => '-MExporter -MExporter'}, ['-I..\lib', '-e0'],
+ "",
+ "");
+
+try({PERL5OPT => '-Mstrict -Mwarnings'},
+ ['-I..\lib', '-e', '"print \"ok\" if $INC{\"strict.pm\"} and $INC{\"warnings.pm\"}"'],
+ "ok",
+ "");
+
+open my $fh, ">", "Oooof.pm" or die "Can't write Oooof.pm: $!";
+print $fh "package Oooof; 1;\n";
+close $fh;
+END { 1 while unlink "Oooof.pm" }
+
+try({PERL5OPT => '-I. -MOooof'},
+ ['-e', '"print \"ok\" if $INC{\"Oooof.pm\"} eq \"Oooof.pm\""'],
+ "ok",
+ "");
+
+try({PERL5OPT => '-w -w'},
+ ['-e', '"print $ENV{PERL5OPT}"'],
+ '-w -w',
+ '');
+
+try({PERL5OPT => '-t'},
+ ['-e', '"print ${^TAINT}"'],
+ '-1',
+ '');
+
+try({PERL5OPT => '-W'},
+ ['-I..\lib','-e', '"local $^W = 0; no warnings; print $x"'],
+ '',
+ <<ERROR
+Name "main::x" used only once: possible typo at -e line 1.
+Use of uninitialized value \$x in print at -e line 1.
+ERROR
+);
+
+try({PERLLIB => "foobar$Config{path_sep}42"},
+ ['-e', '"print grep { $_ eq \"foobar\" } @INC"'],
+ 'foobar',
+ '');
+
+try({PERLLIB => "foobar$Config{path_sep}42"},
+ ['-e', '"print grep { $_ eq \"42\" } @INC"'],
+ '42',
+ '');
+
+try({PERL5LIB => "foobar$Config{path_sep}42"},
+ ['-e', '"print grep { $_ eq \"foobar\" } @INC"'],
+ 'foobar',
+ '');
+
+try({PERL5LIB => "foobar$Config{path_sep}42"},
+ ['-e', '"print grep { $_ eq \"42\" } @INC"'],
+ '42',
+ '');
+
+try({PERL5LIB => "foo",
+ PERLLIB => "bar"},
+ ['-e', '"print grep { $_ eq \"foo\" } @INC"'],
+ 'foo',
+ '');
+
+try({PERL5LIB => "foo",
+ PERLLIB => "bar"},
+ ['-e', '"print grep { $_ eq \"bar\" } @INC"'],
+ '',
+ '');
+
+# Tests for S_incpush_use_sep():
+
+my @dump_inc = ('-e', '"print \"$_\n\" foreach @INC"');
+
+my ($out, $err) = runperl_and_capture({}, [@dump_inc]);
+
+is ($err, '', 'No errors when determining @INC');
+
+my @default_inc = split /\n/, $out;
+
+is ($default_inc[-1], '.', '. is last in @INC');
+
+my $sep = $Config{path_sep};
+my @test_cases = (
+ ['nothing', ''],
+ ['something', 'zwapp', 'zwapp'],
+ ['two things', "zwapp${sep}bam", 'zwapp', 'bam'],
+ ['two things, ::', "zwapp${sep}${sep}bam", 'zwapp', 'bam'],
+ [': at start', "${sep}zwapp", 'zwapp'],
+ [': at end', "zwapp${sep}", 'zwapp'],
+ [':: sandwich ::', "${sep}${sep}zwapp${sep}${sep}", 'zwapp'],
+ [':', "${sep}"],
+ ['::', "${sep}${sep}"],
+ [':::', "${sep}${sep}${sep}"],
+ ['two things and :', "zwapp${sep}bam${sep}", 'zwapp', 'bam'],
+ [': and two things', "${sep}zwapp${sep}bam", 'zwapp', 'bam'],
+ [': two things :', "${sep}zwapp${sep}bam${sep}", 'zwapp', 'bam'],
+ ['three things', "zwapp${sep}bam${sep}${sep}owww",
+ 'zwapp', 'bam', 'owww'],
+);
+
+# This block added to verify fix for RT #87322
+if ($::os_id == 2 and $::os_major == 6) { # Vista, Server 2008 (incl R2), 7
+ my @big_perl5lib = ('z' x 16) x 2049;
+ push @testcases, [
+ 'enough items so PERL5LIB val is longer than 32k',
+ join($sep, @big_perl5lib), @big_perl5lib,
+ ];
+}
+
+foreach ( @testcases ) {
+ my ($name, $lib, @expect) = @$_;
+ push @expect, @default_inc;
+
+ ($out, $err) = runperl_and_capture({PERL5LIB => $lib}, [@dump_inc]);
+
+ is ($err, '', "No errors when determining \@INC for $name");
+
+ my @inc = split /\n/, $out;
+
+ is (scalar @inc, scalar @expect,
+ "expected number of elements in \@INC for $name");
+
+ is ("@inc", "@expect", "expected elements in \@INC for $name");
+}
https://perl5.git.perl.org / perl5.git / commitdiff