t/lib/selfloader.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     $dir = "self-$$";
   6     unshift @INC, ("./$dir", "../lib");
   7
   8     print "1..19\n";
   9
  10     # First we must set up some selfloader files
  11     mkdir $dir, 0755            or die "Can't mkdir $dir: $!";
  12
  13     open(FOO, ">$dir/Foo.pm") or die;
  14     print FOO <<'EOT';
  15 package Foo;
  16 use SelfLoader;
  17
  18 sub new { bless {}, shift }
  19 sub foo;
  20 sub bar;
  21 sub bazmarkhianish;
  22 sub a;
  23 sub never;    # declared but definition should never be read
  24 1;
  25 __DATA__
  26
  27 sub foo { shift; shift || "foo" };
  28
  29 sub bar { shift; shift || "bar" }
  30
  31 sub bazmarkhianish { shift; shift || "baz" }
  32
  33 package sheep;
  34 sub bleat { shift; shift || "baa" }
  35
  36 __END__
  37 sub never { die "D'oh" }
  38 EOT
  39
  40     close(FOO);
  41
  42     open(BAR, ">$dir/Bar.pm") or die;
  43     print BAR <<'EOT';
  44 package Bar;
  45 use SelfLoader;
  46
  47 @ISA = 'Baz';
  48
  49 sub new { bless {}, shift }
  50 sub a;
  51
  52 1;
  53 __DATA__
  54
  55 sub a { 'a Bar'; }
  56 sub b { 'b Bar' }
  57
  58 __END__ DATA
  59 sub never { die "D'oh" }
  60 EOT
  61
  62     close(BAR);
  63 };
  64
  65
  66 package Baz;
  67
  68 sub a { 'a Baz' }
  69 sub b { 'b Baz' }
  70 sub c { 'c Baz' }
  71
  72
  73 package main;
  74 use Foo;
  75 use Bar;
  76
  77 $foo = new Foo;
  78
  79 print "not " unless $foo->foo eq 'foo';  # selfloaded first time
  80 print "ok 1\n";
  81
  82 print "not " unless $foo->foo eq 'foo';  # regular call
  83 print "ok 2\n";
  84
  85 # Try an undefined method
  86 eval {
  87     $foo->will_fail;
  88 };
  89 if ($@ =~ /^Undefined subroutine/) {
  90     print "ok 3\n";
  91 } else {
  92     print "not ok 3 $@\n";
  93 }
  94
  95 # Used to be trouble with this
  96 eval {
  97     my $foo = new Foo;
  98     die "oops";
  99 };
 100 if ($@ =~ /oops/) {
 101     print "ok 4\n";
 102 } else {
 103     print "not ok 4 $@\n";
 104 }
 105
 106 # Pass regular expression variable to autoloaded function.  This used
 107 # to go wrong in AutoLoader because it used regular expressions to generate
 108 # autoloaded filename.
 109 "foo" =~ /(\w+)/;
 110 print "not " unless $1 eq 'foo';
 111 print "ok 5\n";
 112
 113 print "not " unless $foo->bar($1) eq 'foo';
 114 print "ok 6\n";
 115
 116 print "not " unless $foo->bar($1) eq 'foo';
 117 print "ok 7\n";
 118
 119 print "not " unless $foo->bazmarkhianish($1) eq 'foo';
 120 print "ok 8\n";
 121
 122 print "not " unless $foo->bazmarkhianish($1) eq 'foo';
 123 print "ok 9\n";
 124
 125 # Check nested packages inside __DATA__
 126 print "not " unless sheep::bleat()  eq 'baa';
 127 print "ok 10\n";
 128
 129 # Now check inheritance:
 130
 131 $bar = new Bar;
 132
 133 # Before anything is SelfLoaded there is no declaration of Foo::b so we should
 134 # get Baz::b
 135 print "not " unless $bar->b() eq 'b Baz';
 136 print "ok 11\n";
 137
 138 # There is no Bar::c so we should get Baz::c
 139 print "not " unless $bar->c() eq 'c Baz';
 140 print "ok 12\n";
 141
 142 # This selfloads Bar::a because it is stubbed. It also stubs Bar::b as a side
 143 # effect
 144 print "not " unless $bar->a() eq 'a Bar';
 145 print "ok 13\n";
 146
 147 print "not " unless $bar->b() eq 'b Bar';
 148 print "ok 14\n";
 149
 150 print "not " unless $bar->c() eq 'c Baz';
 151 print "ok 15\n";
 152
 153
 154
 155 # Check that __END__ is honoured
 156 # Try an subroutine that should never be noticed by selfloader
 157 eval {
 158     $foo->never;
 159 };
 160 if ($@ =~ /^Undefined subroutine/) {
 161     print "ok 16\n";
 162 } else {
 163     print "not ok 16 $@\n";
 164 }
 165
 166 # Try to read from the data file handle
 167 my $foodata = <Foo::DATA>;
 168 if (defined $foodata) {
 169     print "not ok 17 # $foodata\n";
 170 } else {
 171     print "ok 17\n";
 172 }
 173
 174 # Check that __END__ DATA is honoured
 175 # Try an subroutine that should never be noticed by selfloader
 176 eval {
 177     $bar->never;
 178 };
 179 if ($@ =~ /^Undefined subroutine/) {
 180     print "ok 18\n";
 181 } else {
 182     print "not ok 18 $@\n";
 183 }
 184
 185 # Try to read from the data file handle
 186 my $bardata = <Bar::DATA>;
 187 if ($bardata ne "sub never { die \"D'oh\" }\n") {
 188     print "not ok 19 # $bardata\n";
 189 } else {
 190     print "ok 19\n";
 191 }
 192
 193 # cleanup
 194 END {
 195 return unless $dir && -d $dir;
 196 unlink "$dir/Foo.pm", "$dir/Bar.pm";
 197 rmdir "$dir";
 198 }