Remove core @INC setting and chdir boilerplate from SelfLoader's tests.
[perl.git] / dist / SelfLoader / t / 01SelfLoader.t
1 BEGIN {
2     $dir = "self-$$";
3     $sep = "/";
4
5     if ($^O eq 'MacOS') {
6         $dir = ":" . $dir;
7         $sep = ":";
8     }
9
10     unshift @INC, $dir;
11
12     print "1..20\n";
13
14     # First we must set up some selfloader files
15     mkdir $dir, 0755            or die "Can't mkdir $dir: $!";
16
17     open(FOO, ">$dir${sep}Foo.pm") or die;
18     print FOO <<'EOT';
19 package Foo;
20 use SelfLoader;
21
22 sub new { bless {}, shift }
23 sub foo;
24 sub bar;
25 sub bazmarkhianish;
26 sub a;
27 sub never;    # declared but definition should never be read
28 1;
29 __DATA__
30
31 sub foo { shift; shift || "foo" };
32
33 sub bar { shift; shift || "bar" }
34
35 sub bazmarkhianish { shift; shift || "baz" }
36
37 package sheep;
38 sub bleat { shift; shift || "baa" }
39 __END__
40 sub never { die "D'oh" }
41 EOT
42
43     close(FOO);
44
45     open(BAR, ">$dir${sep}Bar.pm") or die;
46     print BAR <<'EOT';
47 package Bar;
48 use SelfLoader;
49
50 @ISA = 'Baz';
51
52 sub new { bless {}, shift }
53 sub a;
54 sub with_whitespace_in_front;
55
56 1;
57 __DATA__
58
59 sub a { 'a Bar'; }
60 sub b { 'b Bar' }
61
62  sub with_whitespace_in_front {
63   "with_whitespace_in_front Bar"
64 }
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 # check that subs with whitespace in front work
151 print "not " unless $bar->with_whitespace_in_front() eq 'with_whitespace_in_front Bar';
152 print "ok 13\n";
153
154 # This selfloads Bar::a because it is stubbed. It also stubs Bar::b as a side
155 # effect
156 print "not " unless $bar->a() eq 'a Bar';
157 print "ok 14\n";
158
159 print "not " unless $bar->b() eq 'b Bar';
160 print "ok 15\n";
161
162 print "not " unless $bar->c() eq 'c Baz';
163 print "ok 16\n";
164
165
166
167 # Check that __END__ is honoured
168 # Try an subroutine that should never be noticed by selfloader
169 eval {
170     $foo->never;
171 };
172 if ($@ =~ /^Undefined subroutine/) {
173     print "ok 17\n";
174 } else {
175     print "not ok 17 $@\n";
176 }
177
178 # Try to read from the data file handle
179 {
180     local $SIG{__WARN__} = sub { my $warn = shift; };
181     my $foodata = <Foo::DATA>;
182     close Foo::DATA;
183     if (defined $foodata) {
184         print "not ok 18 # $foodata\n";
185     } else {
186         print "ok 18\n";
187     }
188 }
189
190 # Check that __END__ DATA is honoured
191 # Try an subroutine that should never be noticed by selfloader
192 eval {
193     $bar->never;
194 };
195 if ($@ =~ /^Undefined subroutine/) {
196     print "ok 19\n";
197 } else {
198     print "not ok 19 $@\n";
199 }
200
201 # Try to read from the data file handle
202 my $bardata = <Bar::DATA>;
203 close Bar::DATA;
204 if ($bardata ne "sub never { die \"D'oh\" }\n") {
205     print "not ok 20 # $bardata\n";
206 } else {
207     print "ok 20\n";
208 }
209
210 # cleanup
211 END {
212 return unless $dir && -d $dir;
213 unlink "$dir${sep}Foo.pm", "$dir${sep}Bar.pm";
214 rmdir "$dir";
215 }