lib/SelfLoader/t/01SelfLoader.t

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