Front page | perl.perl5.porters |
Postings from August 2001
[PATCH] newer tests for the coderef-in-@INC !
Thread Next
From:
Rafael Garcia-Suarez
Date:
August 28, 2001 14:02
Subject:
[PATCH] newer tests for the coderef-in-@INC !
Message ID:
20010828230432.A6332@rafael
t/op/inccode.t currently works only when perlio is defined.
If I use File::Temp, I can read cleanly from temporary files without
requiring to have perlio.
Is it ok to use File::Temp ? These are high-level tests.
I also added tests to verify that the value of the key placed
in %INC matches the reference put in @INC.
--- t/op/inccode.t.orig Tue Aug 28 01:55:59 2001
+++ t/op/inccode.t Tue Aug 28 22:52:29 2001
@@ -7,27 +7,27 @@
@INC = '../lib';
}
-use Config;
+use File::Temp qw/tempfile/;
+use Test::More tests => 30;
-BEGIN {
- require Test::More;
+sub get_temp_fh {
+ my ($fh,$f) = tempfile("DummyModuleXXXX", DIR => '.', UNLINK => 1);
+ print $fh "package ".substr($_[0],0,-3)."; 1;";
+ close $fh;
+ open $fh, $f or die "Can't open $f: $!";
+ return $fh;
+}
- # This test relies on perlio, but the feature being tested does not.
- # The dependency should eventually be purged and use something like
- # Tie::Handle instead.
- if( $Config{useperlio} ) {
- Test::More->import(tests => 21);
- }
- else {
- Test::More->import('skip_all');
- }
+sub get_addr {
+ my $str = shift;
+ $str =~ /(0x[0-9a-f]+)/i;
+ return $1;
}
sub fooinc {
my ($self, $filename) = @_;
if (substr($filename,0,3) eq 'Foo') {
- open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;");
- return $fh;
+ return get_temp_fh($filename);
}
else {
return undef;
@@ -40,12 +40,18 @@
ok( eval { require Foo; 1 }, 'require() magic via code ref' );
ok( exists $INC{'Foo.pm'}, ' %INC sees it' );
+ok( get_addr($INC{'Foo.pm'}) eq get_addr(\&fooinc),
+ ' key is correct in %INC' );
ok( eval "use Foo1; 1;", 'use()' );
ok( exists $INC{'Foo1.pm'}, ' %INC sees it' );
+ok( get_addr($INC{'Foo1.pm'}) eq get_addr(\&fooinc),
+ ' key is correct in %INC' );
ok( eval { do 'Foo2.pl'; 1 }, 'do()' );
ok( exists $INC{'Foo2.pl'}, ' %INC sees it' );
+ok( get_addr($INC{'Foo2.pl'}) eq get_addr(\&fooinc),
+ ' key is correct in %INC' );
pop @INC;
@@ -53,58 +59,72 @@
sub fooinc2 {
my ($self, $filename) = @_;
if (substr($filename, 0, length($self->[1])) eq $self->[1]) {
- open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;");
- return $fh;
+ return get_temp_fh($filename);
}
else {
return undef;
}
}
-push @INC, [ \&fooinc2, 'Bar' ];
+my $arrayref = [ \&fooinc2, 'Bar' ];
+push @INC, $arrayref;
ok( eval { require Foo; 1; }, 'Originally loaded packages preserved' );
ok( !eval { require Foo3; 1; }, 'Original magic INC purged' );
ok( eval { require Bar; 1 }, 'require() magic via array ref' );
ok( exists $INC{'Bar.pm'}, ' %INC sees it' );
+ok( get_addr($INC{'Bar.pm'}) eq get_addr($arrayref),
+ ' key is correct in %INC' );
ok( eval "use Bar1; 1;", 'use()' );
ok( exists $INC{'Bar1.pm'}, ' %INC sees it' );
+ok( get_addr($INC{'Bar1.pm'}) eq get_addr($arrayref),
+ ' key is correct in %INC' );
ok( eval { do 'Bar2.pl'; 1 }, 'do()' );
ok( exists $INC{'Bar2.pl'}, ' %INC sees it' );
+ok( get_addr($INC{'Bar2.pl'}) eq get_addr($arrayref),
+ ' key is correct in %INC' );
pop @INC;
sub FooLoader::INC {
my ($self, $filename) = @_;
if (substr($filename,0,4) eq 'Quux') {
- open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;");
- return $fh;
+ return get_temp_fh($filename);
}
else {
return undef;
}
}
-push @INC, bless( {}, 'FooLoader' );
+my $href = bless( {}, 'FooLoader' );
+push @INC, $href;
ok( eval { require Quux; 1 }, 'require() magic via hash object' );
ok( exists $INC{'Quux.pm'}, ' %INC sees it' );
+ok( get_addr($INC{'Quux.pm'}) eq get_addr($href),
+ ' key is correct in %INC' );
pop @INC;
-push @INC, bless( [], 'FooLoader' );
+my $aref = bless( [], 'FooLoader' );
+push @INC, $aref;
ok( eval { require Quux1; 1 }, 'require() magic via array object' );
ok( exists $INC{'Quux1.pm'}, ' %INC sees it' );
+ok( get_addr($INC{'Quux1.pm'}) eq get_addr($aref),
+ ' key is correct in %INC' );
pop @INC;
-push @INC, bless( \(my $x = 1), 'FooLoader' );
+my $sref = bless( \(my $x = 1), 'FooLoader' );
+push @INC, $sref;
ok( eval { require Quux2; 1 }, 'require() magic via scalar object' );
ok( exists $INC{'Quux2.pm'}, ' %INC sees it' );
+ok( get_addr($INC{'Quux2.pm'}) eq get_addr($sref),
+ ' key is correct in %INC' );
pop @INC;
Thread Next
-
[PATCH] newer tests for the coderef-in-@INC !
by Rafael Garcia-Suarez