# Tests for the coderef-in-@INC feature
-my $can_fork = 0;
+use Config;
+
+my $can_fork = 0;
+my $minitest = $ENV{PERL_CORE_MINITEST};
+my $has_perlio = $Config{useperlio};
+
BEGIN {
chdir 't' if -d 't';
@INC = qw(. ../lib);
}
-{
- use Config;
- if (PerlIO::Layer->find('perlio') && $Config{d_fork} &&
- eval 'require POSIX; 1') {
+
+if (!$minitest) {
+ if ($Config{d_fork} && eval 'require POSIX; 1') {
$can_fork = 1;
}
}
use File::Spec;
require "test.pl";
-plan(tests => 45 + 14 * $can_fork);
-
-my @tempfiles = ();
+plan(tests => 49 + !$minitest * (3 + 14 * $can_fork));
sub get_temp_fh {
- my $f = "DummyModule0000";
- 1 while -e ++$f;
- push @tempfiles, $f;
+ my $f = tempfile();
open my $fh, ">$f" or die "Can't create $f: $!";
print $fh "package ".substr($_[0],0,-3).";\n1;\n";
print $fh $_[1] if @_ > 1;
return $fh;
}
-END { 1 while unlink @tempfiles }
-
sub fooinc {
my ($self, $filename) = @_;
if (substr($filename,0,3) eq 'Foo') {
$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;
+ my $filename = $^O eq 'MacOS' ? ':Foo:Foo.pm' : './Foo.pm';
+ #local @INC; # local fails on tied @INC
+ my @old_INC = @INC; # because local doesn't work on tied arrays
@INC = sub { $filename = 'seen'; return undef; };
eval { require $filename; };
is( $filename, 'seen', 'the coderef sees fully-qualified pathnames' );
+ @INC = @old_INC;
}
+# this will segfault if it fails
+
+sub PVBM () { 'foo' }
+{ my $dummy = index 'foo', PVBM }
+
+# I don't know whether these requires should succeed or fail. 5.8 failed
+# all of them; 5.10 with an ordinary constant in place of PVBM lets the
+# latter two succeed. For now I don't care, as long as they don't
+# segfault :).
+
+unshift @INC, sub { PVBM };
+eval 'require foo';
+ok( 1, 'returning PVBM doesn\'t segfault require' );
+eval 'use foo';
+ok( 1, 'returning PVBM doesn\'t segfault use' );
+shift @INC;
+unshift @INC, sub { \PVBM };
+eval 'require foo';
+ok( 1, 'returning PVBM ref doesn\'t segfault require' );
+eval 'use foo';
+ok( 1, 'returning PVBM ref doesn\'t segfault use' );
+shift @INC;
+
+exit if $minitest;
+
+SKIP: {
+ skip( "No PerlIO available", 3 ) unless $has_perlio;
+ 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,