bugfix, AutoLoader 0.67

Message-ID: <20080905115602.23307.qmail@lists.develooper.com>
Date: Fri, 05 Sep 2008 13:56:01 +0200

p4raw-id: //depot/perl@34282

diff --git a/lib/AutoLoader.pm b/lib/AutoLoader.pm
index 880acd1..0129002 100644 (file)
--- a/lib/AutoLoader.pm
+++ b/lib/AutoLoader.pm
@@ -15,7 +15,7 @@ BEGIN {
     $is_epoc = $^O eq 'epoc';
     $is_vms = $^O eq 'VMS';
     $is_macos = $^O eq 'MacOS';
-    $VERSION = '5.66';
+    $VERSION = '5.67';
 }
 
 AUTOLOAD {
@@ -155,17 +155,20 @@ sub import {
     (my $calldir = $callpkg) =~ s#::#/#g;
     my $path = $INC{$calldir . '.pm'};
     if (defined($path)) {
-       # Try absolute path name.
+       # Try absolute path name, but only eval it if the
+        # transformation from module path to autosplit.ix path
+        # succeeded!
+       my $replaced_okay;
        if ($is_macos) {
            (my $malldir = $calldir) =~ tr#/#:#;
-           $path =~ s#^(.*)$malldir\.pm\z#$1auto:$malldir:autosplit.ix#s;
+           $replaced_okay = ($path =~ s#^(.*)$malldir\.pm\z#$1auto:$malldir:autosplit.ix#s);
        } else {
-           $path =~ s#^(.*)$calldir\.pm\z#$1auto/$calldir/autosplit.ix#;
+           $replaced_okay = ($path =~ s#^(.*)$calldir\.pm\z#$1auto/$calldir/autosplit.ix#);
        }
 
-       eval { require $path; };
+       eval { require $path; } if $replaced_okay;
        # If that failed, try relative path with normal @INC searching.
-       if ($@) {
+       if (!$replaced_okay or $@) {
            $path ="auto/$calldir/autosplit.ix";
            eval { require $path; };
        }

diff --git a/lib/AutoLoader/t/01AutoLoader.t b/lib/AutoLoader/t/01AutoLoader.t
index 21125ae..09a1425 100755 (executable)
--- a/lib/AutoLoader/t/01AutoLoader.t
+++ b/lib/AutoLoader/t/01AutoLoader.t
@@ -14,51 +14,44 @@ use File::Path;
 my $dir;
 BEGIN
 {
-       $dir = File::Spec->catdir( "auto-$$" );
+    $dir = File::Spec->catdir( "auto-$$" );
     unshift @INC, $dir;
 }
 
-use Test::More tests => 17;
+use Test::More tests => 18;
+
+sub write_file {
+    my ($file, $text) = @_;
+    open my $fh, '>', $file
+      or die "Could not open file '$file' for writing: $!";
+    print $fh $text;
+    close $fh;
+}
 
 # First we must set up some autoloader files
 my $fulldir = File::Spec->catdir( $dir, 'auto', 'Foo' );
 mkpath( $fulldir ) or die "Can't mkdir '$fulldir': $!";
 
-open(FOO, '>', File::Spec->catfile( $fulldir, 'foo.al' ))
-       or die "Can't open foo file: $!";
-print FOO <<'EOT';
+write_file( File::Spec->catfile( $fulldir, 'foo.al' ), <<'EOT' );
 package Foo;
 sub foo { shift; shift || "foo" }
 1;
 EOT
-close(FOO);
 
-open(BAZ, '>', File::Spec->catfile( $fulldir, 'bazmarkhian.al' ))
-       or die "Can't open bazmarkhian file: $!";
-print BAZ <<'EOT';
+write_file( File::Spec->catfile( $fulldir, 'bazmarkhian.al' ), <<'EOT' );
 package Foo;
 sub bazmarkhianish { shift; shift || "baz" }
 1;
 EOT
-close(BAZ);
 
-open(BLECH, '>', File::Spec->catfile( $fulldir, 'blechanawilla.al' ))
-       or die "Can't open blech file: $!";
-print BLECH <<'EOT';
+my $blechanawilla_text = <<'EOT';
 package Foo;
 sub blechanawilla { compilation error (
 EOT
-close(BLECH);
-
+write_file( File::Spec->catfile( $fulldir, 'blechanawilla.al' ), $blechanawilla_text );
 # 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);
+write_file( File::Spec->catfile( $fulldir, 'blechanawil.al' ), $blechanawilla_text );
 
 # Let's define the package
 package Foo;
@@ -111,24 +104,18 @@ eval {
 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: $!";
-print F <<'EOT';
+write_file( File::Spec->catfile( $fulldir, 'a.al' ), <<'EOT' );
 package Foo;
 BEGIN { b() }
 sub a { ::ok( 1, 'adding a new autoloaded method' ); }
 1;
 EOT
-close(F);
-
-open(F, '>', File::Spec->catfile( $fulldir, 'b.al'))
-       or die "Cannot make 'b' file: $!";
-print F <<'EOT';
+write_file( File::Spec->catfile( $fulldir, 'b.al' ), <<'EOT' );
 package Foo;
 sub b { ::ok( 1, 'adding a new autoloaded method' ) }
 1;
 EOT
-close(F);
+
 Foo::a();
 
 package Bar;
@@ -140,7 +127,7 @@ package Foo;
 AutoLoader->unimport();
 eval { Foo->baz() };
 ::like( $@, qr/locate object method "baz"/,
-       'unimport() should remove imported AUTOLOAD()' );
+        'unimport() should remove imported AUTOLOAD()' );
 
 package Baz;
 
@@ -166,8 +153,70 @@ $INC{"SomeClass.pm"} = $0; # Prepare possible recursion
 } # <-- deep recursion in AUTOLOAD looking for SomeClass::DESTROY?
 ::ok(1, "AutoLoader shouldn't loop forever if \%INC is modified");
 
+# Now test the bug that lead to AutoLoader 0.67:
+# If the module is loaded from a file name different than normal,
+# we could formerly have trouble finding autosplit.ix
+# Contributed by Christoph Lamprecht.
+# Recreate the following file structure:
+# auto/MyAddon/autosplit.ix
+# auto/MyAddon/testsub.al
+# MyModule.pm
+SCOPE: {
+    my $autopath = File::Spec->catdir( $dir, 'auto', 'MyAddon' );
+    mkpath( $autopath ) or die "Can't mkdir '$autopath': $!";
+    my $autosplit_text = <<'EOT';
+# Index created by AutoSplit for MyModule.pm
+#    (file acts as timestamp)
+package MyAddon;
+sub testsub ;
+1;
+EOT
+    write_file( File::Spec->catfile( $autopath, 'autosplit.ix' ), $autosplit_text );
+
+    my $testsub_text = <<'EOT';
+# NOTE: Derived from MyModule.pm.
+# Changes made here will be lost when autosplit is run again.
+# See AutoSplit.pm.
+package MyAddon;
+
+#line 13 "MyModule.pm (autosplit into auto/MyAddon/testsub.al)"
+sub testsub{
+    return "MyAddon";
+}
+
+1;
+# end of MyAddon::testsub
+EOT
+    write_file( File::Spec->catfile( $autopath, 'testsub.al' ), $testsub_text);
+
+    my $mymodule_text = <<'EOT';
+use strict;
+use warnings;
+package MyModule;
+sub testsub{return 'MyModule';}
+
+package MyAddon;
+our @ISA = ('MyModule');
+BEGIN{$INC{'MyAddon.pm'} = __FILE__}
+use AutoLoader 'AUTOLOAD';
+1;
+__END__
+
+sub testsub{
+    return "MyAddon";
+}
+EOT
+    write_file( File::Spec->catfile( $dir, 'MyModule.pm' ), $mymodule_text);
+
+    require MyModule;
+
+    my $res = MyAddon->testsub();
+    ::is ($res , 'MyAddon', 'invoke MyAddon::testsub');
+}
+
 # cleanup
 END {
-       return unless $dir && -d $dir;
-       rmtree $dir;
+    return unless $dir && -d $dir;
+    rmtree $dir;
 }
+