t/lib/selfloader.t

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