lib/SelfLoader/t/01SelfLoader.t

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