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 }