# Tests for the coderef-in-@INC feature
+my $can_fork = 0;
BEGIN {
chdir 't' if -d 't';
@INC = qw(. ../lib);
}
+{
+ use Config;
+ if (PerlIO::Layer->find('perlio') && $Config{d_fork} &&
+ eval 'require POSIX; 1') {
+ $can_fork = 1;
+ }
+}
+use strict;
use File::Spec;
require "test.pl";
-plan(tests => 43);
+plan(tests => 45 + 14 * $can_fork);
my @tempfiles = ();
1 while -e ++$f;
push @tempfiles, $f;
open my $fh, ">$f" or die "Can't create $f: $!";
- print $fh "package ".substr($_[0],0,-3)."; 1;";
+ print $fh "package ".substr($_[0],0,-3).";\n1;\n";
+ print $fh $_[1] if @_ > 1;
close $fh or die "Couldn't close: $!";
open $fh, $f or die "Can't open $f: $!";
return $fh;
is( $INC{'Toto.pm'}, 'xyz', ' val Toto.pm is correct in %INC' );
pop @INC;
+
+push @INC, sub {
+ my ($self, $filename) = @_;
+ if ($filename eq 'abc.pl') {
+ return get_temp_fh($filename, qq(return "abc";\n));
+ }
+ else {
+ return undef;
+ }
+};
+
+my $ret = "";
+$ret ||= do 'abc.pl';
+is( $ret, 'abc', 'do "abc.pl" sees return value' );
+
+pop @INC;
+
+my $filename = $^O eq 'MacOS' ? ':Foo:Foo.pm' : './Foo.pm';
+{
+ local @INC;
+ @INC = sub { $filename = 'seen'; return undef; };
+ eval { require $filename; };
+ is( $filename, 'seen', 'the coderef sees fully-qualified pathnames' );
+}
+
+if ($can_fork) {
+ require PerlIO::scalar;
+ # This little bundle of joy generates n more recursive use statements,
+ # with each module chaining the next one down to 0. If it works, then we
+ # can safely nest subprocesses
+ my $use_filter_too;
+ push @INC, sub {
+ return unless $_[1] =~ /^BBBLPLAST(\d+)\.pm/;
+ my $pid = open my $fh, "-|";
+ if ($pid) {
+ # Parent
+ return $fh unless $use_filter_too;
+ # Try filters and state in addition.
+ return ($fh, sub {s/$_[1]/pass/; return}, "die")
+ }
+ die "Can't fork self: $!" unless defined $pid;
+
+ # Child
+ my $count = $1;
+ # Lets force some fun with odd sized reads.
+ $| = 1;
+ print 'push @main::bbblplast, ';
+ print "$count;\n";
+ if ($count--) {
+ print "use BBBLPLAST$count;\n";
+ }
+ if ($use_filter_too) {
+ print "die('In $_[1]');";
+ } else {
+ print "pass('In $_[1]');";
+ }
+ print '"Truth"';
+ POSIX::_exit(0);
+ die "Can't get here: $!";
+ };
+
+ @::bbblplast = ();
+ require BBBLPLAST5;
+ is ("@::bbblplast", "0 1 2 3 4 5", "All ran");
+
+ foreach (keys %INC) {
+ delete $INC{$_} if /^BBBLPLAST/;
+ }
+
+ @::bbblplast = ();
+ $use_filter_too = 1;
+
+ require BBBLPLAST5;
+
+ is ("@::bbblplast", "0 1 2 3 4 5", "All ran with a filter");
+}