| 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 => 14; |
| 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 | |
| 77 | package main; |
| 78 | |
| 79 | my $foo = new Foo; |
| 80 | |
| 81 | is( $foo->foo, 'foo', 'autoloaded first time' ); |
| 82 | is( $foo->foo, 'foo', 'regular call' ); |
| 83 | |
| 84 | eval { |
| 85 | $foo->will_fail; |
| 86 | }; |
| 87 | like( $@, qr/^Can't locate/, 'undefined method' ); |
| 88 | |
| 89 | # Used to be trouble with this |
| 90 | eval { |
| 91 | my $foo = new Foo; |
| 92 | die "oops"; |
| 93 | }; |
| 94 | like( $@, qr/oops/, 'indirect method call' ); |
| 95 | |
| 96 | # Pass regular expression variable to autoloaded function. This used |
| 97 | # to go wrong because AutoLoader used regular expressions to generate |
| 98 | # autoloaded filename. |
| 99 | 'foo' =~ /(\w+)/; |
| 100 | |
| 101 | is( $foo->bar($1), 'foo', 'autoloaded method should not stomp match vars' ); |
| 102 | is( $foo->bar($1), 'foo', '(again)' ); |
| 103 | is( $foo->bazmarkhianish($1), 'foo', 'for any method call' ); |
| 104 | is( $foo->bazmarkhianish($1), 'foo', '(again)' ); |
| 105 | |
| 106 | # Used to retry long subnames with shorter filenames on any old |
| 107 | # exception, including compilation error. Now AutoLoader only |
| 108 | # tries shorter filenames if it can't find the long one. |
| 109 | eval { |
| 110 | $foo->blechanawilla; |
| 111 | }; |
| 112 | like( $@, qr/syntax error/, 'require error propagates' ); |
| 113 | |
| 114 | # test recursive autoloads |
| 115 | open(F, '>', File::Spec->catfile( $fulldir, 'a.al')) |
| 116 | or die "Cannot make 'a' file: $!"; |
| 117 | print F <<'EOT'; |
| 118 | package Foo; |
| 119 | BEGIN { b() } |
| 120 | sub a { ::ok( 1, 'adding a new autoloaded method' ); } |
| 121 | 1; |
| 122 | EOT |
| 123 | close(F); |
| 124 | |
| 125 | open(F, '>', File::Spec->catfile( $fulldir, 'b.al')) |
| 126 | or die "Cannot make 'b' file: $!"; |
| 127 | print F <<'EOT'; |
| 128 | package Foo; |
| 129 | sub b { ::ok( 1, 'adding a new autoloaded method' ) } |
| 130 | 1; |
| 131 | EOT |
| 132 | close(F); |
| 133 | Foo::a(); |
| 134 | |
| 135 | package Bar; |
| 136 | AutoLoader->import(); |
| 137 | ::ok( ! defined &AUTOLOAD, 'AutoLoader should not export AUTOLOAD by default' ); |
| 138 | |
| 139 | package Foo; |
| 140 | AutoLoader->unimport(); |
| 141 | eval { Foo->baz() }; |
| 142 | ::like( $@, qr/locate object method "baz"/, |
| 143 | 'unimport() should remove imported AUTOLOAD()' ); |
| 144 | |
| 145 | package Baz; |
| 146 | |
| 147 | sub AUTOLOAD { 'i am here' } |
| 148 | |
| 149 | AutoLoader->import(); |
| 150 | AutoLoader->unimport(); |
| 151 | |
| 152 | ::is( Baz->AUTOLOAD(), 'i am here', '... but not non-imported AUTOLOAD()' ); |
| 153 | |
| 154 | package main; |
| 155 | |
| 156 | # cleanup |
| 157 | END { |
| 158 | return unless $dir && -d $dir; |
| 159 | rmtree $dir; |
| 160 | } |