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