Commit | Line | Data |
bfdd1499 |
1 | BEGIN { |
2 | chdir 't' if -d 't'; |
3 | $dir = "self-$$"; |
95e8664e |
4 | $sep = "/"; |
5 | |
6 | if ($^O eq 'MacOS') { |
7 | $dir = ":" . $dir; |
8 | $sep = ":"; |
9 | } |
10 | |
0a8174e1 |
11 | unshift @INC, $dir; |
12 | unshift @INC, '../lib'; |
bfdd1499 |
13 | |
1163f0e4 |
14 | print "1..20\n"; |
bfdd1499 |
15 | |
16 | # First we must set up some selfloader files |
17 | mkdir $dir, 0755 or die "Can't mkdir $dir: $!"; |
18 | |
95e8664e |
19 | open(FOO, ">$dir${sep}Foo.pm") or die; |
bfdd1499 |
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" } |
bfdd1499 |
41 | __END__ |
42 | sub never { die "D'oh" } |
43 | EOT |
44 | |
45 | close(FOO); |
46 | |
95e8664e |
47 | open(BAR, ">$dir${sep}Bar.pm") or die; |
bfdd1499 |
48 | print BAR <<'EOT'; |
49 | package Bar; |
50 | use SelfLoader; |
51 | |
52 | @ISA = 'Baz'; |
53 | |
54 | sub new { bless {}, shift } |
55 | sub a; |
1163f0e4 |
56 | sub with_whitespace_in_front; |
bfdd1499 |
57 | |
58 | 1; |
59 | __DATA__ |
60 | |
61 | sub a { 'a Bar'; } |
62 | sub b { 'b Bar' } |
63 | |
1163f0e4 |
64 | sub with_whitespace_in_front { |
65 | "with_whitespace_in_front Bar" |
66 | } |
67 | |
bfdd1499 |
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 | |
1163f0e4 |
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 | |
bfdd1499 |
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'; |
1163f0e4 |
159 | print "ok 14\n"; |
bfdd1499 |
160 | |
161 | print "not " unless $bar->b() eq 'b Bar'; |
1163f0e4 |
162 | print "ok 15\n"; |
bfdd1499 |
163 | |
164 | print "not " unless $bar->c() eq 'c Baz'; |
1163f0e4 |
165 | print "ok 16\n"; |
bfdd1499 |
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/) { |
1163f0e4 |
175 | print "ok 17\n"; |
bfdd1499 |
176 | } else { |
1163f0e4 |
177 | print "not ok 17 $@\n"; |
bfdd1499 |
178 | } |
179 | |
180 | # Try to read from the data file handle |
b75eac34 |
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 | } |
bfdd1499 |
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/) { |
1163f0e4 |
198 | print "ok 19\n"; |
bfdd1499 |
199 | } else { |
1163f0e4 |
200 | print "not ok 19 $@\n"; |
bfdd1499 |
201 | } |
202 | |
203 | # Try to read from the data file handle |
204 | my $bardata = <Bar::DATA>; |
efb7d285 |
205 | close Bar::DATA; |
bfdd1499 |
206 | if ($bardata ne "sub never { die \"D'oh\" }\n") { |
1163f0e4 |
207 | print "not ok 20 # $bardata\n"; |
bfdd1499 |
208 | } else { |
1163f0e4 |
209 | print "ok 20\n"; |
bfdd1499 |
210 | } |
211 | |
212 | # cleanup |
213 | END { |
214 | return unless $dir && -d $dir; |
95e8664e |
215 | unlink "$dir${sep}Foo.pm", "$dir${sep}Bar.pm"; |
bfdd1499 |
216 | rmdir "$dir"; |
217 | } |