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 => 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 }