Upgrade to AutoLoader-5.64
[p5sagit/p5-mst-13.2.git] / lib / AutoLoader / t / 01AutoLoader.t
CommitLineData
7412bda7 1#!./perl -w
a30dce55 2
3BEGIN {
7a752413 4 if ($ENV{PERL_CORE}) {
a30dce55 5 chdir 't' if -d 't';
7a752413 6 @INC = '../lib';
7 }
a30dce55 8}
9
7412bda7 10use strict;
11use File::Spec;
12use File::Path;
13
14my $dir;
15BEGIN
16{
17 $dir = File::Spec->catdir( "auto-$$" );
7a752413 18 unshift @INC, $dir;
7412bda7 19}
20
3256a4f8 21use Test::More tests => 22;
a30dce55 22
23# First we must set up some autoloader files
7412bda7 24my $fulldir = File::Spec->catdir( $dir, 'auto', 'Foo' );
25mkpath( $fulldir ) or die "Can't mkdir '$fulldir': $!";
a30dce55 26
7412bda7 27open(FOO, '>', File::Spec->catfile( $fulldir, 'foo.al' ))
28 or die "Can't open foo file: $!";
a30dce55 29print FOO <<'EOT';
30package Foo;
31sub foo { shift; shift || "foo" }
321;
33EOT
34close(FOO);
35
7412bda7 36open(BAR, '>', File::Spec->catfile( $fulldir, 'bar.al' ))
37 or die "Can't open bar file: $!";
a30dce55 38print BAR <<'EOT';
39package Foo;
40sub bar { shift; shift || "bar" }
411;
42EOT
43close(BAR);
44
7412bda7 45open(BAZ, '>', File::Spec->catfile( $fulldir, 'bazmarkhian.al' ))
46 or die "Can't open bazmarkhian file: $!";
a30dce55 47print BAZ <<'EOT';
48package Foo;
49sub bazmarkhianish { shift; shift || "baz" }
501;
51EOT
52close(BAZ);
53
94825128 54open(BLECH, '>', File::Spec->catfile( $fulldir, 'blechanawilla.al' ))
55 or die "Can't open blech file: $!";
56print BLECH <<'EOT';
57package Foo;
58sub blechanawilla { compilation error (
59EOT
60close(BLECH);
61
62# This is just to keep the old SVR3 systems happy; they may fail
63# to find the above file so we duplicate it where they should find it.
64open(BLECH, '>', File::Spec->catfile( $fulldir, 'blechanawil.al' ))
65 or die "Can't open blech file: $!";
66print BLECH <<'EOT';
67package Foo;
68sub blechanawilla { compilation error (
69EOT
70close(BLECH);
71
a30dce55 72# Let's define the package
73package Foo;
74require AutoLoader;
7412bda7 75AutoLoader->import( 'AUTOLOAD' );
a30dce55 76
77sub new { bless {}, shift };
a498340c 78sub foo;
a498340c 79sub bazmarkhianish;
a30dce55 80
81package main;
82
00bb01c7 83my $foo = Foo->new();
a30dce55 84
a498340c 85my $result = $foo->can( 'foo' );
86ok( $result, 'can() first time' );
7412bda7 87is( $foo->foo, 'foo', 'autoloaded first time' );
88is( $foo->foo, 'foo', 'regular call' );
a498340c 89is( $result, \&Foo::foo, 'can() returns ref to regular installed sub' );
00bb01c7 90$result = $foo->can( 'bar' );
91ok( $result, 'can() should work when importing AUTOLOAD too' );
92is( $foo->bar, 'bar', 'regular call' );
93is( $result, \&Foo::bar, '... returning ref to regular installed sub' );
a30dce55 94
a30dce55 95eval {
96 $foo->will_fail;
97};
7412bda7 98like( $@, qr/^Can't locate/, 'undefined method' );
a30dce55 99
a498340c 100$result = $foo->can( 'will_fail' );
101ok( ! $result, 'can() should fail on undefined methods' );
102
a30dce55 103# Used to be trouble with this
104eval {
00bb01c7 105 my $foo = Foo->new();
a30dce55 106 die "oops";
107};
7412bda7 108like( $@, qr/oops/, 'indirect method call' );
a30dce55 109
110# Pass regular expression variable to autoloaded function. This used
111# to go wrong because AutoLoader used regular expressions to generate
112# autoloaded filename.
7412bda7 113'foo' =~ /(\w+)/;
a30dce55 114
7412bda7 115is( $foo->bar($1), 'foo', 'autoloaded method should not stomp match vars' );
116is( $foo->bar($1), 'foo', '(again)' );
117is( $foo->bazmarkhianish($1), 'foo', 'for any method call' );
118is( $foo->bazmarkhianish($1), 'foo', '(again)' );
a30dce55 119
94825128 120# Used to retry long subnames with shorter filenames on any old
121# exception, including compilation error. Now AutoLoader only
122# tries shorter filenames if it can't find the long one.
123eval {
124 $foo->blechanawilla;
125};
2f3efc97 126like( $@, qr/syntax error/i, 'require error propagates' );
94825128 127
16579924 128# test recursive autoloads
7412bda7 129open(F, '>', File::Spec->catfile( $fulldir, 'a.al'))
130 or die "Cannot make 'a' file: $!";
16579924 131print F <<'EOT';
132package Foo;
133BEGIN { b() }
7412bda7 134sub a { ::ok( 1, 'adding a new autoloaded method' ); }
16579924 1351;
136EOT
137close(F);
138
7412bda7 139open(F, '>', File::Spec->catfile( $fulldir, 'b.al'))
140 or die "Cannot make 'b' file: $!";
16579924 141print F <<'EOT';
142package Foo;
7412bda7 143sub b { ::ok( 1, 'adding a new autoloaded method' ) }
16579924 1441;
145EOT
146close(F);
147Foo::a();
148
7412bda7 149package Bar;
150AutoLoader->import();
151::ok( ! defined &AUTOLOAD, 'AutoLoader should not export AUTOLOAD by default' );
00bb01c7 152::ok( ! defined &can, '... nor can()' );
7412bda7 153
154package Foo;
155AutoLoader->unimport();
156eval { Foo->baz() };
157::like( $@, qr/locate object method "baz"/,
158 'unimport() should remove imported AUTOLOAD()' );
159
160package Baz;
161
162sub AUTOLOAD { 'i am here' }
163
164AutoLoader->import();
165AutoLoader->unimport();
166
167::is( Baz->AUTOLOAD(), 'i am here', '... but not non-imported AUTOLOAD()' );
168
3256a4f8 169
170package SomeClass;
171use AutoLoader 'AUTOLOAD';
172sub new {
173 bless {} => shift;
174}
175
7412bda7 176package main;
177
3256a4f8 178$INC{"SomeClass.pm"} = $0; # Prepare possible recursion
179{
180 my $p = SomeClass->new();
181} # <-- deep recursion in AUTOLOAD looking for SomeClass::DESTROY?
182::ok(1, "AutoLoader shouldn't loop forever if \%INC is modified");
183
a30dce55 184# cleanup
185END {
7412bda7 186 return unless $dir && -d $dir;
94825128 187 rmtree $dir;
a30dce55 188}