lib/AutoLoader/t/01AutoLoader.t

   1 #!./perl -w
   2
   3 BEGIN {
   4   if ($ENV{PERL_CORE}) {
   5     chdir 't' if -d 't';
   6     @INC = '../lib';
   7   }
   8 }
   9
  10 use strict;
  11 use File::Spec;
  12 use File::Path;
  13
  14 my $dir;
  15 BEGIN
  16 {
  17         $dir = File::Spec->catdir( "auto-$$" );
  18     unshift @INC, $dir;
  19 }
  20
  21 use Test::More tests => 22;
  22
  23 # First we must set up some autoloader files
  24 my $fulldir = File::Spec->catdir( $dir, 'auto', 'Foo' );
  25 mkpath( $fulldir ) or die "Can't mkdir '$fulldir': $!";
  26
  27 open(FOO, '>', File::Spec->catfile( $fulldir, 'foo.al' ))
  28         or die "Can't open foo file: $!";
  29 print FOO <<'EOT';
  30 package Foo;
  31 sub foo { shift; shift || "foo" }
  32 1;
  33 EOT
  34 close(FOO);
  35
  36 open(BAR, '>', File::Spec->catfile( $fulldir, 'bar.al' ))
  37         or die "Can't open bar file: $!";
  38 print BAR <<'EOT';
  39 package Foo;
  40 sub bar { shift; shift || "bar" }
  41 1;
  42 EOT
  43 close(BAR);
  44
  45 open(BAZ, '>', File::Spec->catfile( $fulldir, 'bazmarkhian.al' ))
  46         or die "Can't open bazmarkhian file: $!";
  47 print BAZ <<'EOT';
  48 package Foo;
  49 sub bazmarkhianish { shift; shift || "baz" }
  50 1;
  51 EOT
  52 close(BAZ);
  53
  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
  72 # Let's define the package
  73 package Foo;
  74 require AutoLoader;
  75 AutoLoader->import( 'AUTOLOAD' );
  76
  77 sub new { bless {}, shift };
  78 sub foo;
  79 sub bazmarkhianish;
  80
  81 package main;
  82
  83 my $foo = Foo->new();
  84
  85 my $result = $foo->can( 'foo' );
  86 ok( $result,               'can() first time' );
  87 is( $foo->foo, 'foo', 'autoloaded first time' );
  88 is( $foo->foo, 'foo', 'regular call' );
  89 is( $result,   \&Foo::foo, 'can() returns ref to regular installed sub' );
  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' );
  94
  95 eval {
  96     $foo->will_fail;
  97 };
  98 like( $@, qr/^Can't locate/, 'undefined method' );
  99
 100 $result = $foo->can( 'will_fail' );
 101 ok( ! $result,               'can() should fail on undefined methods' );
 102
 103 # Used to be trouble with this
 104 eval {
 105     my $foo = Foo->new();
 106     die "oops";
 107 };
 108 like( $@, qr/oops/, 'indirect method call' );
 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.
 113 'foo' =~ /(\w+)/;
 114
 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)' );
 119
 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 };
 126 like( $@, qr/syntax error/i, 'require error propagates' );
 127
 128 # test recursive autoloads
 129 open(F, '>', File::Spec->catfile( $fulldir, 'a.al'))
 130         or die "Cannot make 'a' file: $!";
 131 print F <<'EOT';
 132 package Foo;
 133 BEGIN { b() }
 134 sub a { ::ok( 1, 'adding a new autoloaded method' ); }
 135 1;
 136 EOT
 137 close(F);
 138
 139 open(F, '>', File::Spec->catfile( $fulldir, 'b.al'))
 140         or die "Cannot make 'b' file: $!";
 141 print F <<'EOT';
 142 package Foo;
 143 sub b { ::ok( 1, 'adding a new autoloaded method' ) }
 144 1;
 145 EOT
 146 close(F);
 147 Foo::a();
 148
 149 package Bar;
 150 AutoLoader->import();
 151 ::ok( ! defined &AUTOLOAD, 'AutoLoader should not export AUTOLOAD by default' );
 152 ::ok( ! defined &can,      '... nor can()' );
 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
 169
 170 package SomeClass;
 171 use AutoLoader 'AUTOLOAD';
 172 sub new {
 173     bless {} => shift;
 174 }
 175
 176 package main;
 177
 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
 184 # cleanup
 185 END {
 186         return unless $dir && -d $dir;
 187         rmtree $dir;
 188 }