I don't think trying to bracket the hires time with lores
[p5sagit/p5-mst-13.2.git] / lib / SelfLoader.t
CommitLineData
bfdd1499 1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 $dir = "self-$$";
95e8664e 6 $sep = "/";
7
8 if ($^O eq 'MacOS') {
9 $dir = ":" . $dir;
10 $sep = ":";
11 }
12
20822f61 13 @INC = $dir;
14 push @INC, '../lib';
bfdd1499 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 22 print FOO <<'EOT';
23package Foo;
24use SelfLoader;
25
26sub new { bless {}, shift }
27sub foo;
28sub bar;
29sub bazmarkhianish;
30sub a;
31sub never; # declared but definition should never be read
321;
33__DATA__
34
35sub foo { shift; shift || "foo" };
36
37sub bar { shift; shift || "bar" }
38
39sub bazmarkhianish { shift; shift || "baz" }
40
41package sheep;
42sub bleat { shift; shift || "baa" }
43
44__END__
45sub never { die "D'oh" }
46EOT
47
48 close(FOO);
49
95e8664e 50 open(BAR, ">$dir${sep}Bar.pm") or die;
bfdd1499 51 print BAR <<'EOT';
52package Bar;
53use SelfLoader;
54
55@ISA = 'Baz';
56
57sub new { bless {}, shift }
58sub a;
59
601;
61__DATA__
62
63sub a { 'a Bar'; }
64sub b { 'b Bar' }
65
66__END__ DATA
67sub never { die "D'oh" }
68EOT
69
70 close(BAR);
71};
72
73
74package Baz;
75
76sub a { 'a Baz' }
77sub b { 'b Baz' }
78sub c { 'c Baz' }
79
80
81package main;
82use Foo;
83use Bar;
84
85$foo = new Foo;
86
87print "not " unless $foo->foo eq 'foo'; # selfloaded first time
88print "ok 1\n";
89
90print "not " unless $foo->foo eq 'foo'; # regular call
91print "ok 2\n";
92
93# Try an undefined method
94eval {
95 $foo->will_fail;
96};
97if ($@ =~ /^Undefined subroutine/) {
98 print "ok 3\n";
99} else {
100 print "not ok 3 $@\n";
101}
102
103# Used to be trouble with this
104eval {
105 my $foo = new Foo;
106 die "oops";
107};
108if ($@ =~ /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+)/;
118print "not " unless $1 eq 'foo';
119print "ok 5\n";
120
121print "not " unless $foo->bar($1) eq 'foo';
122print "ok 6\n";
123
124print "not " unless $foo->bar($1) eq 'foo';
125print "ok 7\n";
126
127print "not " unless $foo->bazmarkhianish($1) eq 'foo';
128print "ok 8\n";
129
130print "not " unless $foo->bazmarkhianish($1) eq 'foo';
131print "ok 9\n";
132
133# Check nested packages inside __DATA__
134print "not " unless sheep::bleat() eq 'baa';
135print "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
143print "not " unless $bar->b() eq 'b Baz';
144print "ok 11\n";
145
146# There is no Bar::c so we should get Baz::c
147print "not " unless $bar->c() eq 'c Baz';
148print "ok 12\n";
149
150# This selfloads Bar::a because it is stubbed. It also stubs Bar::b as a side
151# effect
152print "not " unless $bar->a() eq 'a Bar';
153print "ok 13\n";
154
155print "not " unless $bar->b() eq 'b Bar';
156print "ok 14\n";
157
158print "not " unless $bar->c() eq 'c Baz';
159print "ok 15\n";
160
161
162
163# Check that __END__ is honoured
164# Try an subroutine that should never be noticed by selfloader
165eval {
166 $foo->never;
167};
168if ($@ =~ /^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
175my $foodata = <Foo::DATA>;
efb7d285 176close Foo::DATA;
bfdd1499 177if (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
185eval {
186 $bar->never;
187};
188if ($@ =~ /^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
195my $bardata = <Bar::DATA>;
efb7d285 196close Bar::DATA;
bfdd1499 197if ($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
204END {
205return unless $dir && -d $dir;
95e8664e 206unlink "$dir${sep}Foo.pm", "$dir${sep}Bar.pm";
bfdd1499 207rmdir "$dir";
208}