Remove duplicately applied patch shards.
[p5sagit/p5-mst-13.2.git] / t / lib / selfloader.t
CommitLineData
bfdd1499 1#!./perl
2
3BEGIN {
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';
15package Foo;
16use SelfLoader;
17
18sub new { bless {}, shift }
19sub foo;
20sub bar;
21sub bazmarkhianish;
22sub a;
23sub never; # declared but definition should never be read
241;
25__DATA__
26
27sub foo { shift; shift || "foo" };
28
29sub bar { shift; shift || "bar" }
30
31sub bazmarkhianish { shift; shift || "baz" }
32
33package sheep;
34sub bleat { shift; shift || "baa" }
35
36__END__
37sub never { die "D'oh" }
38EOT
39
40 close(FOO);
41
42 open(BAR, ">$dir/Bar.pm") or die;
43 print BAR <<'EOT';
44package Bar;
45use SelfLoader;
46
47@ISA = 'Baz';
48
49sub new { bless {}, shift }
50sub a;
51
521;
53__DATA__
54
55sub a { 'a Bar'; }
56sub b { 'b Bar' }
57
58__END__ DATA
59sub never { die "D'oh" }
60EOT
61
62 close(BAR);
63};
64
65
66package Baz;
67
68sub a { 'a Baz' }
69sub b { 'b Baz' }
70sub c { 'c Baz' }
71
72
73package main;
74use Foo;
75use Bar;
76
77$foo = new Foo;
78
79print "not " unless $foo->foo eq 'foo'; # selfloaded first time
80print "ok 1\n";
81
82print "not " unless $foo->foo eq 'foo'; # regular call
83print "ok 2\n";
84
85# Try an undefined method
86eval {
87 $foo->will_fail;
88};
89if ($@ =~ /^Undefined subroutine/) {
90 print "ok 3\n";
91} else {
92 print "not ok 3 $@\n";
93}
94
95# Used to be trouble with this
96eval {
97 my $foo = new Foo;
98 die "oops";
99};
100if ($@ =~ /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+)/;
110print "not " unless $1 eq 'foo';
111print "ok 5\n";
112
113print "not " unless $foo->bar($1) eq 'foo';
114print "ok 6\n";
115
116print "not " unless $foo->bar($1) eq 'foo';
117print "ok 7\n";
118
119print "not " unless $foo->bazmarkhianish($1) eq 'foo';
120print "ok 8\n";
121
122print "not " unless $foo->bazmarkhianish($1) eq 'foo';
123print "ok 9\n";
124
125# Check nested packages inside __DATA__
126print "not " unless sheep::bleat() eq 'baa';
127print "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
135print "not " unless $bar->b() eq 'b Baz';
136print "ok 11\n";
137
138# There is no Bar::c so we should get Baz::c
139print "not " unless $bar->c() eq 'c Baz';
140print "ok 12\n";
141
142# This selfloads Bar::a because it is stubbed. It also stubs Bar::b as a side
143# effect
144print "not " unless $bar->a() eq 'a Bar';
145print "ok 13\n";
146
147print "not " unless $bar->b() eq 'b Bar';
148print "ok 14\n";
149
150print "not " unless $bar->c() eq 'c Baz';
151print "ok 15\n";
152
153
154
155# Check that __END__ is honoured
156# Try an subroutine that should never be noticed by selfloader
157eval {
158 $foo->never;
159};
160if ($@ =~ /^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
167my $foodata = <Foo::DATA>;
efb7d285 168close Foo::DATA;
bfdd1499 169if (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
177eval {
178 $bar->never;
179};
180if ($@ =~ /^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
187my $bardata = <Bar::DATA>;
efb7d285 188close Bar::DATA;
bfdd1499 189if ($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
196END {
197return unless $dir && -d $dir;
198unlink "$dir/Foo.pm", "$dir/Bar.pm";
199rmdir "$dir";
200}