defined @array and defined %hash need no warnings 'deprecated';

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

diff --git a/t/op/inccode.t b/t/op/inccode.t
index 268d4f4..7edb345 100644 (file)
--- a/t/op/inccode.t
+++ b/t/op/inccode.t
@@ -2,8 +2,11 @@
 
 # Tests for the coderef-in-@INC feature
 
-my $can_fork = 0;
-my $minitest = $ENV{PERL_CORE_MINITEST};
+use Config;
+
+my $can_fork   = 0;
+my $minitest   = $ENV{PERL_CORE_MINITEST};
+my $has_perlio = $Config{useperlio};
 
 BEGIN {
     chdir 't' if -d 't';
@@ -11,9 +14,7 @@ BEGIN {
 }
 
 if (!$minitest) {
-    use Config; 
-    if (PerlIO::Layer->find('perlio') && $Config{d_fork} &&
-       eval 'require POSIX; 1') {
+    if ($Config{d_fork} && eval 'require POSIX; 1') {
        $can_fork = 1;
     }
 }
@@ -22,14 +23,10 @@ use strict;
 use File::Spec;
 
 require "test.pl";
-plan(tests => 45 + !$minitest * (3 + 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;
@@ -38,8 +35,6 @@ sub get_temp_fh {
     return $fh;
 }
 
-END { 1 while unlink @tempfiles }
-
 sub fooinc {
     my ($self, $filename) = @_;
     if (substr($filename,0,3) eq 'Foo') {
@@ -201,7 +196,7 @@ $ret ||= do 'abc.pl';
 is( $ret, 'abc', 'do "abc.pl" sees return value' );
 
 {
-    my $filename = $^O eq 'MacOS' ? ':Foo:Foo.pm' : './Foo.pm';
+    my $filename = './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; };
@@ -210,29 +205,57 @@ is( $ret, 'abc', 'do "abc.pl" sees return value' );
     @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;
 
-pop @INC;
+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;
-};
+    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' );
+    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) {