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