Allow negative indexing in recursive patterns
[p5sagit/p5-mst-13.2.git] / t / op / inccode.t
index f897852..a64716b 100644 (file)
@@ -3,11 +3,14 @@
 # Tests for the coderef-in-@INC feature
 
 my $can_fork = 0;
+my $minitest = $ENV{PERL_CORE_MINITEST};
+
 BEGIN {
     chdir 't' if -d 't';
     @INC = qw(. ../lib);
 }
-{
+
+if (!$minitest) {
     use Config; 
     if (PerlIO::Layer->find('perlio') && $Config{d_fork} &&
        eval 'require POSIX; 1') {
@@ -19,7 +22,7 @@ use strict;
 use File::Spec;
 
 require "test.pl";
-plan(tests => 45 + 14 * $can_fork);
+plan(tests => 45 + !$minitest * (3 + 14 * $can_fork));
 
 my @tempfiles = ();
 
@@ -197,16 +200,39 @@ 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';
 {
+    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' );
 }
 
+exit if $minitest;
+
+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;
+
 if ($can_fork) {
     require PerlIO::scalar;
     # This little bundle of joy generates n more recursive use statements,