From: chromatic Date: Thu, 3 Oct 2002 22:56:54 +0000 (-0700) Subject: [PROPOSED PATCH lib/AutoLoader.t lib/AutoLoader.pm] Test and Improve unimport() X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7412bda796ef0f9c3874e537e0357f96cf6f16e3;p=p5sagit%2Fp5-mst-13.2.git [PROPOSED PATCH lib/AutoLoader.t lib/AutoLoader.pm] Test and Improve unimport() Message-ID: <20021004060120.33329.qmail@onion.perl.org> p4raw-id: //depot/perl@17996 --- diff --git a/lib/AutoLoader.pm b/lib/AutoLoader.pm index b20b5dd..3afe4af 100644 --- a/lib/AutoLoader.pm +++ b/lib/AutoLoader.pm @@ -167,8 +167,12 @@ sub import { } sub unimport { - my $callpkg = caller; - eval "package $callpkg; sub AUTOLOAD;"; + my $callpkg = caller; + + no strict 'refs'; + my $symname = $callpkg . '::AUTOLOAD'; + undef *{ $symname } if \&{ $symname } == \&AUTOLOAD; + *{ $symname } = \&{ $symname }; } 1; diff --git a/lib/AutoLoader.t b/lib/AutoLoader.t index f2fae7f..2db1d60 100755 --- a/lib/AutoLoader.t +++ b/lib/AutoLoader.t @@ -1,26 +1,29 @@ -#!./perl +#!./perl -w BEGIN { chdir 't' if -d 't'; - if ($^O eq 'MacOS') { - $dir = ":auto-$$"; - $sep = ":"; - } else { - $dir = "auto-$$"; - $sep = "/"; - } - @INC = $dir; - push @INC, '../lib'; + @INC = '../lib'; } -print "1..11\n"; +use strict; +use File::Spec; +use File::Path; + +my $dir; +BEGIN +{ + $dir = File::Spec->catdir( "auto-$$" ); + unshift @INC, $dir; +} + +use Test::More tests => 13; # First we must set up some autoloader files -mkdir $dir, 0755 or die "Can't mkdir $dir: $!"; -mkdir "$dir${sep}auto", 0755 or die "Can't mkdir: $!"; -mkdir "$dir${sep}auto${sep}Foo", 0755 or die "Can't mkdir: $!"; +my $fulldir = File::Spec->catdir( $dir, 'auto', 'Foo' ); +mkpath( $fulldir ) or die "Can't mkdir '$fulldir': $!"; -open(FOO, ">$dir${sep}auto${sep}Foo${sep}foo.al") or die; +open(FOO, '>', File::Spec->catfile( $fulldir, 'foo.al' )) + or die "Can't open foo file: $!"; print FOO <<'EOT'; package Foo; sub foo { shift; shift || "foo" } @@ -28,7 +31,8 @@ sub foo { shift; shift || "foo" } EOT close(FOO); -open(BAR, ">$dir${sep}auto${sep}Foo${sep}bar.al") or die; +open(BAR, '>', File::Spec->catfile( $fulldir, 'bar.al' )) + or die "Can't open bar file: $!"; print BAR <<'EOT'; package Foo; sub bar { shift; shift || "bar" } @@ -36,7 +40,8 @@ sub bar { shift; shift || "bar" } EOT close(BAR); -open(BAZ, ">$dir${sep}auto${sep}Foo${sep}bazmarkhian.al") or die; +open(BAZ, '>', File::Spec->catfile( $fulldir, 'bazmarkhian.al' )) + or die "Can't open bazmarkhian file: $!"; print BAZ <<'EOT'; package Foo; sub bazmarkhianish { shift; shift || "baz" } @@ -47,82 +52,83 @@ close(BAZ); # Let's define the package package Foo; require AutoLoader; -@ISA=qw(AutoLoader); +AutoLoader->import( 'AUTOLOAD' ); sub new { bless {}, shift }; package main; -$foo = new Foo; - -print "not " unless $foo->foo eq 'foo'; # autoloaded first time -print "ok 1\n"; +my $foo = new Foo; -print "not " unless $foo->foo eq 'foo'; # regular call -print "ok 2\n"; +is( $foo->foo, 'foo', 'autoloaded first time' ); +is( $foo->foo, 'foo', 'regular call' ); -# Try an undefined method eval { $foo->will_fail; }; -print "not " unless $@ =~ /^Can't locate/; -print "ok 3\n"; +like( $@, qr/^Can't locate/, 'undefined method' ); # Used to be trouble with this eval { my $foo = new Foo; die "oops"; }; -print "not " unless $@ =~ /oops/; -print "ok 4\n"; +like( $@, qr/oops/, 'indirect method call' ); # Pass regular expression variable to autoloaded function. This used # to go wrong because AutoLoader used regular expressions to generate # autoloaded filename. -"foo" =~ /(\w+)/; -print "not " unless $1 eq 'foo'; -print "ok 5\n"; +'foo' =~ /(\w+)/; -print "not " unless $foo->bar($1) eq 'foo'; -print "ok 6\n"; - -print "not " unless $foo->bar($1) eq 'foo'; -print "ok 7\n"; - -print "not " unless $foo->bazmarkhianish($1) eq 'foo'; -print "ok 8\n"; - -print "not " unless $foo->bazmarkhianish($1) eq 'foo'; -print "ok 9\n"; +is( $foo->bar($1), 'foo', 'autoloaded method should not stomp match vars' ); +is( $foo->bar($1), 'foo', '(again)' ); +is( $foo->bazmarkhianish($1), 'foo', 'for any method call' ); +is( $foo->bazmarkhianish($1), 'foo', '(again)' ); # test recursive autoloads -open(F, ">$dir${sep}auto${sep}Foo${sep}a.al") or die; +open(F, '>', File::Spec->catfile( $fulldir, 'a.al')) + or die "Cannot make 'a' file: $!"; print F <<'EOT'; package Foo; BEGIN { b() } -sub a { print "ok 11\n"; } +sub a { ::ok( 1, 'adding a new autoloaded method' ); } 1; EOT close(F); -open(F, ">$dir${sep}auto${sep}Foo${sep}b.al") or die; +open(F, '>', File::Spec->catfile( $fulldir, 'b.al')) + or die "Cannot make 'b' file: $!"; print F <<'EOT'; package Foo; -sub b { print "ok 10\n"; } +sub b { ::ok( 1, 'adding a new autoloaded method' ) } 1; EOT close(F); Foo::a(); +package Bar; +AutoLoader->import(); +::ok( ! defined &AUTOLOAD, 'AutoLoader should not export AUTOLOAD by default' ); + +package Foo; +AutoLoader->unimport(); +eval { Foo->baz() }; +::like( $@, qr/locate object method "baz"/, + 'unimport() should remove imported AUTOLOAD()' ); + +package Baz; + +sub AUTOLOAD { 'i am here' } + +AutoLoader->import(); +AutoLoader->unimport(); + +::is( Baz->AUTOLOAD(), 'i am here', '... but not non-imported AUTOLOAD()' ); + +package main; + # cleanup END { -return unless $dir && -d $dir; -unlink "$dir${sep}auto${sep}Foo${sep}foo.al"; -unlink "$dir${sep}auto${sep}Foo${sep}bar.al"; -unlink "$dir${sep}auto${sep}Foo${sep}bazmarkhian.al"; -unlink "$dir${sep}auto${sep}Foo${sep}a.al"; -unlink "$dir${sep}auto${sep}Foo${sep}b.al"; -rmdir "$dir${sep}auto${sep}Foo"; -rmdir "$dir${sep}auto"; -rmdir "$dir"; + return unless $dir && -d $dir; + rmtree $fulldir; }