X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FAutoLoader.t;h=92d66fa7314d7ec550b552209b9f2887e2d99f7f;hb=5108dc18037af131227ae095719eaab3a8fd54cb;hp=2db1d60ed1dffc59d15119cb598aa4d6b4bc6d1f;hpb=7412bda796ef0f9c3874e537e0357f96cf6f16e3;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/AutoLoader.t b/lib/AutoLoader.t
index 2db1d60..92d66fa 100755
--- a/lib/AutoLoader.t
+++ b/lib/AutoLoader.t
@@ -16,7 +16,7 @@ BEGIN
 	unshift @INC, $dir;
 }
 
-use Test::More tests => 13;
+use Test::More tests => 22;
 
 # First we must set up some autoloader files
 my $fulldir = File::Spec->catdir( $dir, 'auto', 'Foo' );
@@ -49,28 +49,58 @@ sub bazmarkhianish { shift; shift || "baz" }
 EOT
 close(BAZ);
 
+open(BLECH, '>', File::Spec->catfile( $fulldir, 'blechanawilla.al' ))
+       or die "Can't open blech file: $!";
+print BLECH <<'EOT';
+package Foo;
+sub blechanawilla { compilation error (
+EOT
+close(BLECH);
+
+# This is just to keep the old SVR3 systems happy; they may fail
+# to find the above file so we duplicate it where they should find it.
+open(BLECH, '>', File::Spec->catfile( $fulldir, 'blechanawil.al' ))
+       or die "Can't open blech file: $!";
+print BLECH <<'EOT';
+package Foo;
+sub blechanawilla { compilation error (
+EOT
+close(BLECH);
+
 # Let's define the package
 package Foo;
 require AutoLoader;
 AutoLoader->import( 'AUTOLOAD' );
 
 sub new { bless {}, shift };
+sub foo;
+sub bazmarkhianish; 
 
 package main;
 
-my $foo = new Foo;
+my $foo = Foo->new();
 
+my $result = $foo->can( 'foo' );
+ok( $result,               'can() first time' );
 is( $foo->foo, 'foo', 'autoloaded first time' );
 is( $foo->foo, 'foo', 'regular call' );
+is( $result,   \&Foo::foo, 'can() returns ref to regular installed sub' );
+$result    = $foo->can( 'bar' );
+ok( $result,               'can() should work when importing AUTOLOAD too' );
+is( $foo->bar, 'bar', 'regular call' );
+is( $result,   \&Foo::bar, '... returning ref to regular installed sub' );
 
 eval {
     $foo->will_fail;
 };
 like( $@, qr/^Can't locate/, 'undefined method' );
 
+$result = $foo->can( 'will_fail' );
+ok( ! $result,               'can() should fail on undefined methods' );
+
 # Used to be trouble with this
 eval {
-    my $foo = new Foo;
+    my $foo = Foo->new();
     die "oops";
 };
 like( $@, qr/oops/, 'indirect method call' );
@@ -85,6 +115,14 @@ is( $foo->bar($1), 'foo', '(again)' );
 is( $foo->bazmarkhianish($1), 'foo', 'for any method call' );
 is( $foo->bazmarkhianish($1), 'foo', '(again)' );
 
+# Used to retry long subnames with shorter filenames on any old
+# exception, including compilation error.  Now AutoLoader only
+# tries shorter filenames if it can't find the long one.
+eval {
+  $foo->blechanawilla;
+};
+like( $@, qr/syntax error/i, 'require error propagates' );
+
 # test recursive autoloads
 open(F, '>', File::Spec->catfile( $fulldir, 'a.al'))
 	or die "Cannot make 'a' file: $!";
@@ -109,6 +147,7 @@ Foo::a();
 package Bar;
 AutoLoader->import();
 ::ok( ! defined &AUTOLOAD, 'AutoLoader should not export AUTOLOAD by default' );
+::ok( ! defined &can,      '... nor can()' );
 
 package Foo;
 AutoLoader->unimport();
@@ -125,10 +164,23 @@ AutoLoader->unimport();
 
 ::is( Baz->AUTOLOAD(), 'i am here', '... but not non-imported AUTOLOAD()' );
 
+
+package SomeClass;
+use AutoLoader 'AUTOLOAD';
+sub new {
+    bless {} => shift;
+}
+
 package main;
 
+$INC{"SomeClass.pm"} = $0; # Prepare possible recursion
+{
+    my $p = SomeClass->new();
+} # <-- deep recursion in AUTOLOAD looking for SomeClass::DESTROY?
+::ok(1, "AutoLoader shouldn't loop forever if \%INC is modified");
+
 # cleanup
 END {
 	return unless $dir && -d $dir;
-	rmtree $fulldir;
+	rmtree $dir;
 }