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 => 21;
  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 bazmarkhianish;
  78
  79 package main;
  80
  81 my $foo = Foo->new();
  82
  83 my $result = $foo->can( 'foo' );
  84 ok( $result,               'can() first time' );
  85 is( $foo->foo, 'foo', 'autoloaded first time' );
  86 is( $foo->foo, 'foo', 'regular call' );
  87 is( $result,   \&Foo::foo, 'can() returns ref to regular installed sub' );
  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' );
  92
  93 eval {
  94     $foo->will_fail;
  95 };
  96 like( $@, qr/^Can't locate/, 'undefined method' );
  97
  98 $result = $foo->can( 'will_fail' );
  99 ok( ! $result,               'can() should fail on undefined methods' );
 100
 101 # Used to be trouble with this
 102 eval {
 103     my $foo = Foo->new();
 104     die "oops";
 105 };
 106 like( $@, qr/oops/, 'indirect method call' );
 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.
 111 'foo' =~ /(\w+)/;
 112
 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)' );
 117
 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 };
 124 like( $@, qr/syntax error/i, 'require error propagates' );
 125
 126 # test recursive autoloads
 127 open(F, '>', File::Spec->catfile( $fulldir, 'a.al'))
 128         or die "Cannot make 'a' file: $!";
 129 print F <<'EOT';
 130 package Foo;
 131 BEGIN { b() }
 132 sub a { ::ok( 1, 'adding a new autoloaded method' ); }
 133 1;
 134 EOT
 135 close(F);
 136
 137 open(F, '>', File::Spec->catfile( $fulldir, 'b.al'))
 138         or die "Cannot make 'b' file: $!";
 139 print F <<'EOT';
 140 package Foo;
 141 sub b { ::ok( 1, 'adding a new autoloaded method' ) }
 142 1;
 143 EOT
 144 close(F);
 145 Foo::a();
 146
 147 package Bar;
 148 AutoLoader->import();
 149 ::ok( ! defined &AUTOLOAD, 'AutoLoader should not export AUTOLOAD by default' );
 150 ::ok( ! defined &can,      '... nor can()' );
 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
 169 # cleanup
 170 END {
 171         return unless $dir && -d $dir;
 172         rmtree $dir;
 173 }