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 => 13;
  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 # Let's define the package
  53 package Foo;
  54 require AutoLoader;
  55 AutoLoader->import( 'AUTOLOAD' );
  56
  57 sub new { bless {}, shift };
  58
  59 package main;
  60
  61 my $foo = new Foo;
  62
  63 is( $foo->foo, 'foo', 'autoloaded first time' );
  64 is( $foo->foo, 'foo', 'regular call' );
  65
  66 eval {
  67     $foo->will_fail;
  68 };
  69 like( $@, qr/^Can't locate/, 'undefined method' );
  70
  71 # Used to be trouble with this
  72 eval {
  73     my $foo = new Foo;
  74     die "oops";
  75 };
  76 like( $@, qr/oops/, 'indirect method call' );
  77
  78 # Pass regular expression variable to autoloaded function.  This used
  79 # to go wrong because AutoLoader used regular expressions to generate
  80 # autoloaded filename.
  81 'foo' =~ /(\w+)/;
  82
  83 is( $foo->bar($1), 'foo', 'autoloaded method should not stomp match vars' );
  84 is( $foo->bar($1), 'foo', '(again)' );
  85 is( $foo->bazmarkhianish($1), 'foo', 'for any method call' );
  86 is( $foo->bazmarkhianish($1), 'foo', '(again)' );
  87
  88 # test recursive autoloads
  89 open(F, '>', File::Spec->catfile( $fulldir, 'a.al'))
  90         or die "Cannot make 'a' file: $!";
  91 print F <<'EOT';
  92 package Foo;
  93 BEGIN { b() }
  94 sub a { ::ok( 1, 'adding a new autoloaded method' ); }
  95 1;
  96 EOT
  97 close(F);
  98
  99 open(F, '>', File::Spec->catfile( $fulldir, 'b.al'))
 100         or die "Cannot make 'b' file: $!";
 101 print F <<'EOT';
 102 package Foo;
 103 sub b { ::ok( 1, 'adding a new autoloaded method' ) }
 104 1;
 105 EOT
 106 close(F);
 107 Foo::a();
 108
 109 package Bar;
 110 AutoLoader->import();
 111 ::ok( ! defined &AUTOLOAD, 'AutoLoader should not export AUTOLOAD by default' );
 112
 113 package Foo;
 114 AutoLoader->unimport();
 115 eval { Foo->baz() };
 116 ::like( $@, qr/locate object method "baz"/,
 117         'unimport() should remove imported AUTOLOAD()' );
 118
 119 package Baz;
 120
 121 sub AUTOLOAD { 'i am here' }
 122
 123 AutoLoader->import();
 124 AutoLoader->unimport();
 125
 126 ::is( Baz->AUTOLOAD(), 'i am here', '... but not non-imported AUTOLOAD()' );
 127
 128 package main;
 129
 130 # cleanup
 131 END {
 132         return unless $dir && -d $dir;
 133         rmtree $fulldir;
 134 }