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