Commit | Line | Data |
---|---|---|
bfdd1499 GS |
1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | $dir = "self-$$"; | |
95e8664e CN |
6 | $sep = "/"; |
7 | ||
8 | if ($^O eq 'MacOS') { | |
9 | $dir = ":" . $dir; | |
10 | $sep = ":"; | |
11 | } | |
12 | ||
20822f61 MG |
13 | @INC = $dir; |
14 | push @INC, '../lib'; | |
bfdd1499 GS |
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 | ||
95e8664e | 21 | open(FOO, ">$dir${sep}Foo.pm") or die; |
bfdd1499 GS |
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 | ||
95e8664e | 50 | open(BAR, ">$dir${sep}Bar.pm") or die; |
bfdd1499 GS |
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>; | |
efb7d285 | 176 | close Foo::DATA; |
bfdd1499 GS |
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>; | |
efb7d285 | 196 | close Bar::DATA; |
bfdd1499 GS |
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; | |
95e8664e | 206 | unlink "$dir${sep}Foo.pm", "$dir${sep}Bar.pm"; |
bfdd1499 GS |
207 | rmdir "$dir"; |
208 | } |