Front page | perl.perl5.porters |
Postings from August 2001
Re: [PATCH] new tests for the coderef-in-@INC
Thread Previous
From:
Michael G Schwern
Date:
August 27, 2001 16:47
Subject:
Re: [PATCH] new tests for the coderef-in-@INC
Message ID:
20010827194730.C12582@blackrider
On Tue, Aug 28, 2001 at 12:02:46AM +0100, Nicholas Clark wrote:
> On Mon, Aug 27, 2001 at 10:36:27PM +0200, Rafael Garcia-Suarez wrote:
> > I wrote some basic tests for the coderef-in-@INC feature.
> > I placed them in a new file t/op/inccode.t (I also patched MANIFEST).
Not to be a broken record here, but could we switch this to
Test::More? It's not critical functionality.
--- /dev/null Mon Aug 27 19:46:54 2001
+++ /usr/local/src/perl-current/t/op/inccode.t Mon Aug 27 19:46:54 2001
@@ -0,0 +1,110 @@
+#!./perl -wT
+
+# Tests for the coderef-in-@INC feature
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use Config;
+
+BEGIN {
+ require Test::More;
+
+ # 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 fooinc {
+ my ($self, $filename) = @_;
+ if (substr($filename,0,3) eq 'Foo') {
+ open my $fh, '<', \("package ".substr($filename,0,-3)."; 1;");
+ return $fh;
+ }
+ else {
+ return undef;
+ }
+}
+
+push @INC, \&fooinc;
+
+ok( !eval { require Bar; 1 }, 'Trying non-magic package' );
+
+ok( eval { require Foo; 1 }, 'require() magic via code ref' );
+ok( exists $INC{'Foo.pm'}, ' %INC sees it' );
+
+ok( eval "use Foo1; 1;", 'use()' );
+ok( exists $INC{'Foo1.pm'}, ' %INC sees it' );
+
+ok( eval { do 'Foo2.pl'; 1 }, 'do()' );
+ok( exists $INC{'Foo2.pl'}, ' %INC sees it' );
+
+pop @INC;
+
+
+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;
+ }
+ else {
+ return undef;
+ }
+}
+
+push @INC, [ \&fooinc2, 'Bar' ];
+
+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( eval "use Bar1; 1;", 'use()' );
+ok( exists $INC{'Bar1.pm'}, ' %INC sees it' );
+
+ok( eval { do 'Bar2.pl'; 1 }, 'do()' );
+ok( exists $INC{'Bar2.pl'}, ' %INC sees it' );
+
+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;
+ }
+ else {
+ return undef;
+ }
+}
+
+push @INC, bless( {}, 'FooLoader' );
+
+ok( eval { require Quux; 1 }, 'require() magic via hash object' );
+ok( exists $INC{'Quux.pm'}, ' %INC sees it' );
+
+pop @INC;
+
+push @INC, bless( [], 'FooLoader' );
+
+ok( eval { require Quux1; 1 }, 'require() magic via array object' );
+ok( exists $INC{'Quux1.pm'}, ' %INC sees it' );
+
+pop @INC;
+
+push @INC, bless( \(my $x = 1), 'FooLoader' );
+
+ok( eval { require Quux2; 1 }, 'require() magic via scalar object' );
+ok( exists $INC{'Quux2.pm'}, ' %INC sees it' );
+
+pop @INC;
--- /usr/local/src/perl-current/MANIFEST~ Mon Aug 27 19:36:48 2001
+++ /usr/local/src/perl-current/MANIFEST Mon Aug 27 19:36:48 2001
@@ -2034,6 +2034,7 @@
t/op/gv.t See if typeglobs work
t/op/hashwarn.t See if warnings for bad hash assignments work
t/op/inc.t See if inc/dec of integers near 32 bit limit work
+t/op/inccode.t See if refs work in @INC
t/op/index.t See if index works
t/op/int.t See if int works
t/op/join.t See if join works
--
Michael G. Schwern <schwern@pobox.com> http://www.pobox.com/~schwern/
Perl6 Quality Assurance <perl-qa@perl.org> Kwalitee Is Job One
Manipulation is its own reward
http://www.goats.com/archive/010430.html
Thread Previous