When code is loaded through an @INC-hook, and when this hook

[p5sagit/p5-mst-13.2.git] / t / op / inccode.t

diff --git a/t/op/inccode.t b/t/op/inccode.t
index 49ab85f..d9516fa 100644 (file)
--- a/t/op/inccode.t
+++ b/t/op/inccode.t
@@ -2,15 +2,24 @@
 
 # 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 => 48 + 14 * $can_fork);
 
 my @tempfiles = ();
 
@@ -19,7 +28,8 @@ sub get_temp_fh {
     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;
@@ -172,3 +182,100 @@ ok( ! ref $INC{'Toto.pm'},         q/  val Toto.pm isn't a ref in %INC/ );
 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;
+
+push @INC, sub {
+    my ($cr, $filename) = @_;
+    my $module = $filename; $module =~ s,/,::,g; $module =~ s/\.pm$//;
+    open my $fh, '<', \"package $module; sub complain { warn q() }; \$::file = __FILE__;"
+       or die $!;
+    $INC{$filename} = "/custom/path/to/$filename";
+    return $fh;
+};
+
+require Publius::Vergilius::Maro;
+is( $INC{'Publius/Vergilius/Maro.pm'}, '/custom/path/to/Publius/Vergilius/Maro.pm', '%INC set correctly');
+is( our $file, '/custom/path/to/Publius/Vergilius/Maro.pm', '__FILE__ set correctly' );
+{
+    my $warning;
+    local $SIG{__WARN__} = sub { $warning = shift };
+    Publius::Vergilius::Maro::complain();
+    like( $warning, qr{something's wrong at /custom/path/to/Publius/Vergilius/Maro.pm}, 'warn() reports correct file source' );
+}
+
+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");
+}