print "1..0 # Skip: no fork\n";
exit 0;
}
+ require './test.pl'
}
-use Test;
+plan tests => 78;
-plan tests => 15;
-
-my $STDOUT = './results-0';
-my $STDERR = './results-1';
-my $PERL = './perl';
+my $STDOUT = tempfile();
+my $STDERR = tempfile();
+my $PERL = $ENV{PERL} || './perl';
my $FAILURE_CODE = 119;
-# Run perl with specified environment and arguments returns a list.
-# First element is true if Perl's stdout and stderr match the
-# supplied $stdout and $stderr argument strings exactly.
-# second element is an explanation of the failure
-sub runperl {
- local *F;
- my ($env, $args, $stdout, $stderr) = @_;
+delete $ENV{PERLLIB};
+delete $ENV{PERL5LIB};
+delete $ENV{PERL5OPT};
+
+sub runperl_and_capture {
+ local *F;
+ my ($env, $args) = @_;
unshift @$args, '-I../lib';
- $stdout = '' unless defined $stdout;
- $stderr = '' unless defined $stderr;
+ local %ENV = %ENV;
+ delete $ENV{PERLLIB};
+ delete $ENV{PERL5LIB};
+ delete $ENV{PERL5OPT};
my $pid = fork;
return (0, "Couldn't fork: $!") unless defined $pid; # failure
if ($pid) { # parent
open F, "< $STDERR" or return (0, "Couldn't read $STDERR file");
{ local $/; $actual_stderr = <F> }
- if ($actual_stdout ne $stdout) {
- return (0, "Stdout mismatch: expected [$stdout], saw [$actual_stdout]");
- } elsif ($actual_stderr ne $stderr) {
- return (0, "Stderr mismatch: expected [$stderr], saw [$actual_stderr]");
- } else {
- return 1; # success
- }
+ return ($actual_stdout, $actual_stderr);
} else { # child
for my $k (keys %$env) {
$ENV{$k} = $env->{$k};
}
}
+# Run perl with specified environment and arguments returns a list.
+# First element is true if Perl's stdout and stderr match the
+# supplied $stdout and $stderr argument strings exactly.
+# second element is an explanation of the failure
+sub runperl {
+ local *F;
+ my ($env, $args, $stdout, $stderr) = @_;
+ my ($actual_stdout, $actual_stderr) = runperl_and_capture($env, $args);
+ if ($actual_stdout ne $stdout) {
+ return (0, "Stdout mismatch: expected [$stdout], saw [$actual_stdout]");
+ } elsif ($actual_stderr ne $stderr) {
+ return (0, "Stderr mismatch: expected [$stderr], saw [$actual_stderr]");
+ } else {
+ return 1; # success
+ }
+}
sub it_didnt_work {
print STDOUT "IWHCWJIHCI\cNHJWCJQWKJQJWCQW\n";
sub try {
my ($success, $reason) = runperl(@_);
$reason =~ s/\n/\\n/g if defined $reason;
- ok( !!$success, 1, $reason );
+ local $::Level = $::Level + 1;
+ ok( $success, $reason );
}
# PERL5OPT Command-line options (switches). Switches in
try({PERL5OPT => '-w'}, ['-e', 'print $::x'],
"",
- qq{Name "main::x" used only once: possible typo at -e line 1.\nUse of uninitialized value in print at -e line 1.\n});
+ 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});
try({PERL5OPT => '-Mstrict'}, ['-e', 'print $::x'],
"", "");
"",
<<ERROR
Name "main::x" used only once: possible typo at -e line 1.
-Use of uninitialized value in print at -e line 1.
+Use of uninitialized value \$x in print at -e line 1.
ERROR
);
"",
<<ERROR
Name "main::x" used only once: possible typo at -e line 1.
-Use of uninitialized value in print at -e line 1.
+Use of uninitialized value \$x in print at -e line 1.
ERROR
);
"ok",
"");
+open F, ">", "Oooof.pm" or die "Can't write Oooof.pm: $!";
+print F "package Oooof; 1;\n";
+close F;
+END { 1 while unlink "Oooof.pm" }
+
+try({PERL5OPT => '-I. -MOooof'},
+ ['-e', 'print "ok" if $INC{"Oooof.pm"} eq "Oooof.pm"'],
+ "ok",
+ "");
+
+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',
+ '-1',
'');
-try({PERLLIB => "foobar:42"},
+try({PERL5OPT => '-W'},
+ ['-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:42"},
+try({PERLLIB => "foobar$Config{path_sep}42"},
['-e', 'print grep { $_ eq "42" } @INC'],
'42',
'');
-try({PERL5LIB => "foobar:42"},
+try({PERL5LIB => "foobar$Config{path_sep}42"},
['-e', 'print grep { $_ eq "foobar" } @INC'],
'foobar',
'');
-try({PERL5LIB => "foobar:42"},
+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 (shift @default_inc, '../lib', 'Our -I../lib is at the front');
+
+my $sep = $Config{path_sep};
+foreach (['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'],
+ ) {
+ 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 (shift @inc, '../lib', 'Our -I../lib is at the front for $name');
+
+ is (scalar @inc, scalar @expect,
+ "expected number of elements in \@INC for $name");
+
+ is ("@inc", "@expect", "expected elements in \@INC for $name");
+}
+
# PERL5LIB tests with included arch directories still missing
END {