Commit | Line | Data |
7412bda7 |
1 | #!./perl -w |
a30dce55 |
2 | |
3 | BEGIN { |
7a752413 |
4 | if ($ENV{PERL_CORE}) { |
a30dce55 |
5 | chdir 't' if -d 't'; |
7a752413 |
6 | @INC = '../lib'; |
7 | } |
a30dce55 |
8 | } |
9 | |
7412bda7 |
10 | use strict; |
11 | use File::Spec; |
12 | use File::Path; |
13 | |
14 | my $dir; |
15 | BEGIN |
16 | { |
17 | $dir = File::Spec->catdir( "auto-$$" ); |
7a752413 |
18 | unshift @INC, $dir; |
7412bda7 |
19 | } |
20 | |
3256a4f8 |
21 | use Test::More tests => 22; |
a30dce55 |
22 | |
23 | # First we must set up some autoloader files |
7412bda7 |
24 | my $fulldir = File::Spec->catdir( $dir, 'auto', 'Foo' ); |
25 | mkpath( $fulldir ) or die "Can't mkdir '$fulldir': $!"; |
a30dce55 |
26 | |
7412bda7 |
27 | open(FOO, '>', File::Spec->catfile( $fulldir, 'foo.al' )) |
28 | or die "Can't open foo file: $!"; |
a30dce55 |
29 | print FOO <<'EOT'; |
30 | package Foo; |
31 | sub foo { shift; shift || "foo" } |
32 | 1; |
33 | EOT |
34 | close(FOO); |
35 | |
7412bda7 |
36 | open(BAR, '>', File::Spec->catfile( $fulldir, 'bar.al' )) |
37 | or die "Can't open bar file: $!"; |
a30dce55 |
38 | print BAR <<'EOT'; |
39 | package Foo; |
40 | sub bar { shift; shift || "bar" } |
41 | 1; |
42 | EOT |
43 | close(BAR); |
44 | |
7412bda7 |
45 | open(BAZ, '>', File::Spec->catfile( $fulldir, 'bazmarkhian.al' )) |
46 | or die "Can't open bazmarkhian file: $!"; |
a30dce55 |
47 | print BAZ <<'EOT'; |
48 | package Foo; |
49 | sub bazmarkhianish { shift; shift || "baz" } |
50 | 1; |
51 | EOT |
52 | close(BAZ); |
53 | |
94825128 |
54 | open(BLECH, '>', File::Spec->catfile( $fulldir, 'blechanawilla.al' )) |
55 | or die "Can't open blech file: $!"; |
56 | print BLECH <<'EOT'; |
57 | package Foo; |
58 | sub blechanawilla { compilation error ( |
59 | EOT |
60 | close(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. |
64 | open(BLECH, '>', File::Spec->catfile( $fulldir, 'blechanawil.al' )) |
65 | or die "Can't open blech file: $!"; |
66 | print BLECH <<'EOT'; |
67 | package Foo; |
68 | sub blechanawilla { compilation error ( |
69 | EOT |
70 | close(BLECH); |
71 | |
a30dce55 |
72 | # Let's define the package |
73 | package Foo; |
74 | require AutoLoader; |
7412bda7 |
75 | AutoLoader->import( 'AUTOLOAD' ); |
a30dce55 |
76 | |
77 | sub new { bless {}, shift }; |
a498340c |
78 | sub foo; |
a498340c |
79 | sub bazmarkhianish; |
a30dce55 |
80 | |
81 | package main; |
82 | |
00bb01c7 |
83 | my $foo = Foo->new(); |
a30dce55 |
84 | |
a498340c |
85 | my $result = $foo->can( 'foo' ); |
86 | ok( $result, 'can() first time' ); |
7412bda7 |
87 | is( $foo->foo, 'foo', 'autoloaded first time' ); |
88 | is( $foo->foo, 'foo', 'regular call' ); |
a498340c |
89 | is( $result, \&Foo::foo, 'can() returns ref to regular installed sub' ); |
00bb01c7 |
90 | $result = $foo->can( 'bar' ); |
91 | ok( $result, 'can() should work when importing AUTOLOAD too' ); |
92 | is( $foo->bar, 'bar', 'regular call' ); |
93 | is( $result, \&Foo::bar, '... returning ref to regular installed sub' ); |
a30dce55 |
94 | |
a30dce55 |
95 | eval { |
96 | $foo->will_fail; |
97 | }; |
7412bda7 |
98 | like( $@, qr/^Can't locate/, 'undefined method' ); |
a30dce55 |
99 | |
a498340c |
100 | $result = $foo->can( 'will_fail' ); |
101 | ok( ! $result, 'can() should fail on undefined methods' ); |
102 | |
a30dce55 |
103 | # Used to be trouble with this |
104 | eval { |
00bb01c7 |
105 | my $foo = Foo->new(); |
a30dce55 |
106 | die "oops"; |
107 | }; |
7412bda7 |
108 | like( $@, 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 |
115 | is( $foo->bar($1), 'foo', 'autoloaded method should not stomp match vars' ); |
116 | is( $foo->bar($1), 'foo', '(again)' ); |
117 | is( $foo->bazmarkhianish($1), 'foo', 'for any method call' ); |
118 | is( $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. |
123 | eval { |
124 | $foo->blechanawilla; |
125 | }; |
2f3efc97 |
126 | like( $@, qr/syntax error/i, 'require error propagates' ); |
94825128 |
127 | |
16579924 |
128 | # test recursive autoloads |
7412bda7 |
129 | open(F, '>', File::Spec->catfile( $fulldir, 'a.al')) |
130 | or die "Cannot make 'a' file: $!"; |
16579924 |
131 | print F <<'EOT'; |
132 | package Foo; |
133 | BEGIN { b() } |
7412bda7 |
134 | sub a { ::ok( 1, 'adding a new autoloaded method' ); } |
16579924 |
135 | 1; |
136 | EOT |
137 | close(F); |
138 | |
7412bda7 |
139 | open(F, '>', File::Spec->catfile( $fulldir, 'b.al')) |
140 | or die "Cannot make 'b' file: $!"; |
16579924 |
141 | print F <<'EOT'; |
142 | package Foo; |
7412bda7 |
143 | sub b { ::ok( 1, 'adding a new autoloaded method' ) } |
16579924 |
144 | 1; |
145 | EOT |
146 | close(F); |
147 | Foo::a(); |
148 | |
7412bda7 |
149 | package Bar; |
150 | AutoLoader->import(); |
151 | ::ok( ! defined &AUTOLOAD, 'AutoLoader should not export AUTOLOAD by default' ); |
00bb01c7 |
152 | ::ok( ! defined &can, '... nor can()' ); |
7412bda7 |
153 | |
154 | package Foo; |
155 | AutoLoader->unimport(); |
156 | eval { Foo->baz() }; |
157 | ::like( $@, qr/locate object method "baz"/, |
158 | 'unimport() should remove imported AUTOLOAD()' ); |
159 | |
160 | package Baz; |
161 | |
162 | sub AUTOLOAD { 'i am here' } |
163 | |
164 | AutoLoader->import(); |
165 | AutoLoader->unimport(); |
166 | |
167 | ::is( Baz->AUTOLOAD(), 'i am here', '... but not non-imported AUTOLOAD()' ); |
168 | |
3256a4f8 |
169 | |
170 | package SomeClass; |
171 | use AutoLoader 'AUTOLOAD'; |
172 | sub new { |
173 | bless {} => shift; |
174 | } |
175 | |
7412bda7 |
176 | package 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 |
185 | END { |
7412bda7 |
186 | return unless $dir && -d $dir; |
94825128 |
187 | rmtree $dir; |
a30dce55 |
188 | } |