extra code in pp_concat, Take 2
[p5sagit/p5-mst-13.2.git] / lib / AutoLoader.t
1 #!./perl -w
2
3 BEGIN {
4     chdir 't' if -d 't';
5         @INC = '../lib';
6 }
7
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
19 use Test::More tests => 17;
20
21 # First we must set up some autoloader files
22 my $fulldir = File::Spec->catdir( $dir, 'auto', 'Foo' );
23 mkpath( $fulldir ) or die "Can't mkdir '$fulldir': $!";
24
25 open(FOO, '>', File::Spec->catfile( $fulldir, 'foo.al' ))
26         or die "Can't open foo file: $!";
27 print FOO <<'EOT';
28 package Foo;
29 sub foo { shift; shift || "foo" }
30 1;
31 EOT
32 close(FOO);
33
34 open(BAR, '>', File::Spec->catfile( $fulldir, 'bar.al' ))
35         or die "Can't open bar file: $!";
36 print BAR <<'EOT';
37 package Foo;
38 sub bar { shift; shift || "bar" }
39 1;
40 EOT
41 close(BAR);
42
43 open(BAZ, '>', File::Spec->catfile( $fulldir, 'bazmarkhian.al' ))
44         or die "Can't open bazmarkhian file: $!";
45 print BAZ <<'EOT';
46 package Foo;
47 sub bazmarkhianish { shift; shift || "baz" }
48 1;
49 EOT
50 close(BAZ);
51
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
70 # Let's define the package
71 package Foo;
72 require AutoLoader;
73 AutoLoader->import( 'AUTOLOAD' );
74
75 sub new { bless {}, shift };
76 sub foo;
77 sub bar;
78 sub bazmarkhianish; 
79
80 package main;
81
82 my $foo = new Foo;
83
84 my $result = $foo->can( 'foo' );
85 ok( $result,               'can() first time' );
86 is( $foo->foo, 'foo', 'autoloaded first time' );
87 is( $foo->foo, 'foo', 'regular call' );
88 is( $result,   \&Foo::foo, 'can() returns ref to regular installed sub' );
89
90 eval {
91     $foo->will_fail;
92 };
93 like( $@, qr/^Can't locate/, 'undefined method' );
94
95 $result = $foo->can( 'will_fail' );
96 ok( ! $result,               'can() should fail on undefined methods' );
97
98 # Used to be trouble with this
99 eval {
100     my $foo = new Foo;
101     die "oops";
102 };
103 like( $@, qr/oops/, 'indirect method call' );
104
105 # Pass regular expression variable to autoloaded function.  This used
106 # to go wrong because AutoLoader used regular expressions to generate
107 # autoloaded filename.
108 'foo' =~ /(\w+)/;
109
110 is( $foo->bar($1), 'foo', 'autoloaded method should not stomp match vars' );
111 is( $foo->bar($1), 'foo', '(again)' );
112 is( $foo->bazmarkhianish($1), 'foo', 'for any method call' );
113 is( $foo->bazmarkhianish($1), 'foo', '(again)' );
114
115 # Used to retry long subnames with shorter filenames on any old
116 # exception, including compilation error.  Now AutoLoader only
117 # tries shorter filenames if it can't find the long one.
118 eval {
119   $foo->blechanawilla;
120 };
121 like( $@, qr/syntax error/, 'require error propagates' );
122
123 # test recursive autoloads
124 open(F, '>', File::Spec->catfile( $fulldir, 'a.al'))
125         or die "Cannot make 'a' file: $!";
126 print F <<'EOT';
127 package Foo;
128 BEGIN { b() }
129 sub a { ::ok( 1, 'adding a new autoloaded method' ); }
130 1;
131 EOT
132 close(F);
133
134 open(F, '>', File::Spec->catfile( $fulldir, 'b.al'))
135         or die "Cannot make 'b' file: $!";
136 print F <<'EOT';
137 package Foo;
138 sub b { ::ok( 1, 'adding a new autoloaded method' ) }
139 1;
140 EOT
141 close(F);
142 Foo::a();
143
144 package Bar;
145 AutoLoader->import();
146 ::ok( ! defined &AUTOLOAD, 'AutoLoader should not export AUTOLOAD by default' );
147
148 package Foo;
149 AutoLoader->unimport();
150 eval { Foo->baz() };
151 ::like( $@, qr/locate object method "baz"/,
152         'unimport() should remove imported AUTOLOAD()' );
153
154 package Baz;
155
156 sub AUTOLOAD { 'i am here' }
157
158 AutoLoader->import();
159 AutoLoader->unimport();
160
161 ::is( Baz->AUTOLOAD(), 'i am here', '... but not non-imported AUTOLOAD()' );
162
163 package main;
164
165 # cleanup
166 END {
167         return unless $dir && -d $dir;
168         rmtree $dir;
169 }