Commit | Line | Data |
---|---|---|
81ba8d96 NC |
1 | #!./perl -w |
2 | ||
3 | # AutoLoader.t runs before this test, so it seems safe to assume that it will | |
4 | # work. | |
5 | ||
6 | my $incdir; | |
7 | my $lib = '"-I../lib"'; # ok on unix, nt, The extra \" are for VMS | |
8 | BEGIN { | |
9 | chdir 't' if -d 't'; | |
08cdd7a3 JH |
10 | if ($^O eq 'dos') { |
11 | print "1..0 # This test is not 8.3-aware.\n"; | |
12 | exit 0; | |
13 | } | |
81ba8d96 NC |
14 | if ($^O eq 'MacOS') { |
15 | $incdir = ":auto-$$"; | |
16 | $lib = '-x -I::lib:'; # -x overcomes MPW $Config{startperl} anomaly | |
17 | } else { | |
18 | $incdir = "auto-$$"; | |
19 | } | |
20 | @INC = $incdir; | |
21 | push @INC, '../lib'; | |
22 | } | |
23 | my $runperl = "$^X $lib"; | |
24 | ||
25 | use warnings; | |
26 | use strict; | |
27 | use Test::More tests => 58; | |
28 | use File::Spec; | |
29 | use File::Find; | |
30 | ||
31 | require AutoSplit; # Run time. Check it compiles. | |
32 | ok (1, "AutoSplit loaded"); | |
33 | ||
34 | END { | |
35 | use File::Path; | |
36 | print "# $incdir being removed...\n"; | |
37 | rmtree($incdir); | |
38 | } | |
39 | ||
40 | mkdir $incdir,0755; | |
41 | ||
42 | my @tests; | |
43 | { | |
44 | # local this else it buggers up the chomp() below. | |
45 | # Hmm. Would be nice to have this as a regexp. | |
46 | local $/ | |
47 | = "################################################################\n"; | |
48 | @tests = <DATA>; | |
49 | close DATA; | |
50 | } | |
51 | ||
88e878ad NK |
52 | my $pathsep = $^O eq 'MSWin32' ? '\\' : '/'; |
53 | ||
81ba8d96 NC |
54 | sub split_a_file { |
55 | my $contents = shift; | |
56 | my $file = $_[0]; | |
57 | if (defined $contents) { | |
58 | open FILE, ">$file" or die "Can't open $file: $!"; | |
59 | print FILE $contents; | |
60 | close FILE or die "Can't close $file: $!"; | |
61 | } | |
62 | ||
63 | # Assumption: no characters in arguments need escaping from the shell or perl | |
64 | my $com = qq($runperl -e "use AutoSplit; autosplit (qw(@_))"); | |
88e878ad | 65 | print "# command: $com\n"; |
81ba8d96 NC |
66 | # There may be a way to capture STDOUT without spawning a child process, but |
67 | # it's probably worthwhile spawning, as it ensures that nothing in AutoSplit | |
68 | # can load functions from split modules into this perl. | |
69 | my $output = `$com`; | |
70 | warn "Exit status $? from running: >>$com<<" if $?; | |
71 | return $output; | |
72 | } | |
73 | ||
74 | my $i = 0; | |
64a3d80f CB |
75 | my $dir = File::Spec->catdir($incdir, 'auto'); |
76 | if ($^O eq 'VMS') { | |
77 | $dir = VMS::Filespec::unixify($dir); | |
78 | $dir =~ s/\/$//; | |
79 | } | |
81ba8d96 NC |
80 | foreach (@tests) { |
81 | my $module = 'A' . $i . '_' . $$ . 'splittest'; | |
82 | my $file = File::Spec->catfile($incdir,"$module.pm"); | |
83 | s/\*INC\*/$incdir/gm; | |
84 | s/\*DIR\*/$dir/gm; | |
85 | s/\*MOD\*/$module/gm; | |
88e878ad | 86 | s/\*PATHSEP\*/$pathsep/gm; |
64a3d80f | 87 | s#//#/#gm; |
81ba8d96 NC |
88 | # Build a hash for this test. |
89 | my %args = /^\#\#\ ([^\n]*)\n # Key is on a line starting ## | |
90 | ((?:[^\#]+ # Any number of characters not # | |
91 | | \#(?!\#) # or a # character not followed by # | |
92 | | (?<!\n)\# # or a # character not preceded by \n | |
93 | )*)/sgmx; | |
a94ed19d | 94 | foreach ($args{Name}, $args{Require}, $args{Extra}) { |
81ba8d96 NC |
95 | chomp $_ if defined $_; |
96 | } | |
97 | my @extra_args = !defined $args{Extra} ? () : split /,/, $args{Extra}; | |
98 | my ($output, $body); | |
99 | if ($args{File}) { | |
100 | $body ="package $module;\n" . $args{File}; | |
101 | $output = split_a_file ($body, $file, $dir, @extra_args); | |
102 | } else { | |
103 | # Repeat tests | |
104 | $output = split_a_file (undef, $file, $dir, @extra_args); | |
105 | } | |
106 | ||
64a3d80f CB |
107 | if ($^O eq 'VMS') { |
108 | my ($filespec, $replacement); | |
109 | while ($output =~ m/(\[.+\])/) { | |
110 | $filespec = $1; | |
111 | $replacement = VMS::Filespec::unixify($filespec); | |
64a3d80f | 112 | $replacement =~ s/\/$//; |
18e548ce | 113 | $output =~ s/\Q$filespec\E/$replacement/; |
64a3d80f CB |
114 | } |
115 | } | |
116 | ||
81ba8d96 | 117 | # test n+1 |
4940c443 | 118 | cmp_ok ($output, 'eq', $args{Get}, "Output from autosplit()ing $args{Name}"); |
81ba8d96 NC |
119 | |
120 | if ($args{Files}) { | |
121 | $args{Files} =~ s!/!:!gs if $^O eq 'MacOS'; | |
122 | my (%missing, %got); | |
123 | find (sub {$got{$File::Find::name}++ unless -d $_}, $dir); | |
124 | foreach (split /\n/, $args{Files}) { | |
125 | next if /^#/; | |
64a3d80f | 126 | $_ = lc($_) if $^O eq 'VMS'; |
81ba8d96 NC |
127 | unless (delete $got{$_}) { |
128 | $missing{$_}++; | |
129 | } | |
130 | } | |
131 | my @missing = keys %missing; | |
132 | # test n+2 | |
133 | unless (ok (!@missing, "Are any expected files missing?")) { | |
134 | print "# These files are missing\n"; | |
135 | print "# $_\n" foreach sort @missing; | |
136 | } | |
137 | my @extra = keys %got; | |
138 | # test n+3 | |
139 | unless (ok (!@extra, "Are any extra files present?")) { | |
140 | print "# These files are unexpectedly present:\n"; | |
141 | print "# $_\n" foreach sort @extra; | |
142 | } | |
143 | } | |
144 | if ($args{Require}) { | |
145 | my $com = 'require "' . File::Spec->catfile ('auto', $args{Require}) . '"'; | |
88e878ad | 146 | $com =~ s{\\}{/}gm if ($^O eq 'MSWin32'); |
81ba8d96 NC |
147 | eval $com; |
148 | # test n+3 | |
149 | ok ($@ eq '', $com) or print "# \$\@ = '$@'\n"; | |
150 | if (defined $body) { | |
151 | eval $body or die $@; | |
152 | } | |
153 | } | |
154 | # match tests to check for prototypes | |
155 | if ($args{Match}) { | |
156 | local $/; | |
157 | my $file = File::Spec->catfile($dir, $args{Require}); | |
158 | open IX, $file or die "Can't open '$file': $!"; | |
159 | my $ix = <IX>; | |
160 | close IX or die "Can't close '$file': $!"; | |
161 | foreach my $pat (split /\n/, $args{Match}) { | |
162 | next if $pat =~ /^\#/; | |
163 | like ($ix, qr/^\s*$pat\s*$/m, "match $pat"); | |
164 | } | |
165 | } | |
166 | # code tests contain eval{}ed ok()s etc | |
167 | if ($args{Tests}) { | |
168 | foreach my $code (split /\n/, $args{Tests}) { | |
169 | next if $code =~ /^\#/; | |
170 | defined eval $code or fail(), print "# Code: $code\n# Error: $@"; | |
171 | } | |
172 | } | |
975263bc NC |
173 | if (my $sleepfor = $args{Sleep}) { |
174 | # We need to sleep for a while | |
175 | # Need the sleep hack else the next test is so fast that the timestamp | |
176 | # compare routine in AutoSplit thinks that it shouldn't split the files. | |
177 | my $time = time; | |
178 | my $until = $time + $sleepfor; | |
179 | my $attempts = 3; | |
180 | do { | |
181 | sleep ($sleepfor) | |
182 | } while (time < $until && --$attempts > 0); | |
183 | if ($attempts == 0) { | |
184 | printf << "EOM", time; | |
185 | # Attempted to sleep for $sleepfor second(s), started at $time, now %d. | |
186 | # sleep attempt ppears to have failed; some tests may fail as a result. | |
187 | EOM | |
188 | } | |
189 | } | |
81ba8d96 NC |
190 | unless ($args{SameAgain}) { |
191 | $i++; | |
192 | rmtree($dir); | |
193 | mkdir $dir, 0775; | |
194 | } | |
195 | } | |
196 | ||
197 | __DATA__ | |
198 | ## Name | |
199 | tests from the end of the AutoSplit module. | |
200 | ## File | |
201 | use AutoLoader 'AUTOLOAD'; | |
202 | {package Just::Another; | |
203 | use AutoLoader 'AUTOLOAD'; | |
204 | } | |
205 | @Yet::Another::AutoSplit::ISA = 'AutoLoader'; | |
206 | 1; | |
207 | __END__ | |
208 | sub test1 ($) { "test 1"; } | |
209 | sub test2 ($$) { "test 2"; } | |
210 | sub test3 ($$$) { "test 3"; } | |
211 | sub testtesttesttest4_1 { "test 4"; } | |
212 | sub testtesttesttest4_2 { "duplicate test 4"; } | |
213 | sub Just::Another::test5 { "another test 5"; } | |
214 | sub test6 { return join ":", __FILE__,__LINE__; } | |
215 | package Yet::Another::AutoSplit; | |
216 | sub testtesttesttest4_1 ($) { "another test 4"; } | |
217 | sub testtesttesttest4_2 ($$) { "another duplicate test 4"; } | |
218 | package Yet::More::Attributes; | |
219 | sub test_a1 ($) : locked :locked { 1; } | |
220 | sub test_a2 : locked { 1; } | |
221 | # And that was all it has. You were expected to manually inspect the output | |
222 | ## Get | |
223 | Warning: AutoSplit had to create top-level *DIR* unexpectedly. | |
88e878ad NK |
224 | AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*) |
225 | *INC**PATHSEP**MOD*.pm: some names are not unique when truncated to 8 characters: | |
226 | directory *DIR**PATHSEP**MOD*: | |
81ba8d96 | 227 | testtesttesttest4_1.al, testtesttesttest4_2.al truncate to testtest |
88e878ad | 228 | directory *DIR**PATHSEP*Yet*PATHSEP*Another*PATHSEP*AutoSplit: |
81ba8d96 NC |
229 | testtesttesttest4_1.al, testtesttesttest4_2.al truncate to testtest |
230 | ## Files | |
231 | *DIR*/*MOD*/autosplit.ix | |
232 | *DIR*/*MOD*/test1.al | |
233 | *DIR*/*MOD*/test2.al | |
234 | *DIR*/*MOD*/test3.al | |
235 | *DIR*/*MOD*/testtesttesttest4_1.al | |
236 | *DIR*/*MOD*/testtesttesttest4_2.al | |
237 | *DIR*/Just/Another/test5.al | |
238 | *DIR*/*MOD*/test6.al | |
239 | *DIR*/Yet/Another/AutoSplit/testtesttesttest4_1.al | |
240 | *DIR*/Yet/Another/AutoSplit/testtesttesttest4_2.al | |
241 | *DIR*/Yet/More/Attributes/test_a1.al | |
242 | *DIR*/Yet/More/Attributes/test_a2.al | |
243 | ## Require | |
244 | *MOD*/autosplit.ix | |
245 | ## Match | |
246 | # Need to find these lines somewhere in the required file | |
247 | sub test1\s*\(\$\); | |
248 | sub test2\s*\(\$\$\); | |
249 | sub test3\s*\(\$\$\$\); | |
250 | sub testtesttesttest4_1\s*\(\$\); | |
251 | sub testtesttesttest4_2\s*\(\$\$\); | |
252 | sub test_a1\s*\(\$\)\s*:\s*locked\s*:\s*locked\s*; | |
253 | sub test_a2\s*:\s*locked\s*; | |
254 | ## Tests | |
255 | is (*MOD*::test1 (1), 'test 1'); | |
256 | is (*MOD*::test2 (1,2), 'test 2'); | |
257 | is (*MOD*::test3 (1,2,3), 'test 3'); | |
258 | ok (!defined eval "*MOD*::test1 () eq 'test 1'" and $@ =~ /^Not enough arguments for *MOD*::test1/, "Check prototypes mismatch fails") or print "# \$\@='$@'"; | |
259 | is (&*MOD*::testtesttesttest4_1, "test 4"); | |
260 | is (&*MOD*::testtesttesttest4_2, "duplicate test 4"); | |
261 | is (&Just::Another::test5, "another test 5"); | |
262 | # very messy way to interpolate function into regexp, but it's going to be | |
263 | # needed to get : for Mac filespecs | |
57e04fb8 | 264 | like (&*MOD*::test6, qr!^\Q*INC**PATHSEP**MOD*\E\.pm \(autosplit into \Q@{[File::Spec->catfile('*DIR*','*MOD*', 'test6.al')]}\E\):\d+$!); |
81ba8d96 NC |
265 | ok (Yet::Another::AutoSplit->testtesttesttest4_1 eq "another test 4"); |
266 | ################################################################ | |
267 | ## Name | |
268 | missing use AutoLoader; | |
269 | ## File | |
270 | 1; | |
271 | __END__ | |
272 | ## Get | |
273 | ## Files | |
274 | # There should be no files. | |
275 | ################################################################ | |
276 | ## Name | |
277 | missing use AutoLoader; (but don't skip) | |
278 | ## Extra | |
279 | 0, 0 | |
280 | ## File | |
281 | 1; | |
282 | __END__ | |
283 | ## Get | |
88e878ad | 284 | AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*) |
81ba8d96 NC |
285 | ## Require |
286 | *MOD*/autosplit.ix | |
287 | ## Files | |
288 | *DIR*/*MOD*/autosplit.ix | |
289 | ################################################################ | |
290 | ## Name | |
291 | Split prior to checking whether obsolete files get deleted | |
292 | ## File | |
293 | use AutoLoader 'AUTOLOAD'; | |
294 | 1; | |
295 | __END__ | |
296 | sub obsolete {my $a if 0; return $a++;} | |
297 | sub gonner {warn "This gonner function should never get called"} | |
298 | ## Get | |
88e878ad | 299 | AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*) |
81ba8d96 NC |
300 | ## Require |
301 | *MOD*/autosplit.ix | |
302 | ## Files | |
303 | *DIR*/*MOD*/autosplit.ix | |
304 | *DIR*/*MOD*/gonner.al | |
305 | *DIR*/*MOD*/obsolete.al | |
306 | ## Tests | |
307 | is (&*MOD*::obsolete, 0); | |
308 | is (&*MOD*::obsolete, 1); | |
975263bc | 309 | ## Sleep |
6ed07066 | 310 | 4 |
81ba8d96 NC |
311 | ## SameAgain |
312 | True, so don't scrub this directory. | |
81ba8d96 NC |
313 | IIRC DOS FAT filesystems have only 2 second granularity. |
314 | ################################################################ | |
315 | ## Name | |
316 | Check whether obsolete files get deleted | |
317 | ## File | |
318 | use AutoLoader 'AUTOLOAD'; | |
319 | 1; | |
320 | __END__ | |
321 | sub skeleton {"bones"}; | |
322 | sub ghost {"scream"}; # This definition gets overwritten with the one below | |
323 | sub ghoul {"wail"}; | |
324 | sub zombie {"You didn't use fire."}; | |
325 | sub flying_pig {"Oink oink flap flap"}; | |
326 | ## Get | |
88e878ad | 327 | AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*) |
81ba8d96 NC |
328 | ## Require |
329 | *MOD*/autosplit.ix | |
330 | ## Files | |
331 | *DIR*/*MOD*/autosplit.ix | |
332 | *DIR*/*MOD*/skeleton.al | |
333 | *DIR*/*MOD*/zombie.al | |
334 | *DIR*/*MOD*/ghost.al | |
335 | *DIR*/*MOD*/ghoul.al | |
336 | *DIR*/*MOD*/flying_pig.al | |
337 | ## Tests | |
338 | is (&*MOD*::skeleton, "bones", "skeleton"); | |
ea071790 | 339 | eval {&*MOD*::gonner}; ok ($@ =~ m!^Can't locate auto/*MOD*/gonner.al in \@INC!, "Check &*MOD*::gonner is now a gonner") or print "# \$\@='$@'\n"; |
975263bc | 340 | ## Sleep |
6ed07066 | 341 | 4 |
81ba8d96 NC |
342 | ## SameAgain |
343 | True, so don't scrub this directory. | |
344 | ################################################################ | |
345 | ## Name | |
346 | Check whether obsolete files remain when keep is 1 | |
347 | ## Extra | |
348 | 1, 1 | |
349 | ## File | |
350 | use AutoLoader 'AUTOLOAD'; | |
351 | 1; | |
352 | __END__ | |
353 | sub ghost {"bump"}; | |
354 | sub wraith {9}; | |
355 | ## Get | |
88e878ad | 356 | AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*) |
81ba8d96 NC |
357 | ## Require |
358 | *MOD*/autosplit.ix | |
359 | ## Files | |
360 | *DIR*/*MOD*/autosplit.ix | |
361 | *DIR*/*MOD*/skeleton.al | |
362 | *DIR*/*MOD*/zombie.al | |
363 | *DIR*/*MOD*/ghost.al | |
364 | *DIR*/*MOD*/ghoul.al | |
365 | *DIR*/*MOD*/wraith.al | |
366 | *DIR*/*MOD*/flying_pig.al | |
367 | ## Tests | |
368 | is (&*MOD*::ghost, "bump"); | |
369 | is (&*MOD*::zombie, "You didn't use fire.", "Are our zombies undead?"); | |
975263bc | 370 | ## Sleep |
6ed07066 | 371 | 4 |
81ba8d96 NC |
372 | ## SameAgain |
373 | True, so don't scrub this directory. | |
374 | ################################################################ | |
375 | ## Name | |
d1be9408 | 376 | Without the timestamp check make sure that nothing happens |
81ba8d96 NC |
377 | ## Extra |
378 | 0, 1, 1 | |
379 | ## Require | |
380 | *MOD*/autosplit.ix | |
381 | ## Files | |
382 | *DIR*/*MOD*/autosplit.ix | |
383 | *DIR*/*MOD*/skeleton.al | |
384 | *DIR*/*MOD*/zombie.al | |
385 | *DIR*/*MOD*/ghost.al | |
386 | *DIR*/*MOD*/ghoul.al | |
387 | *DIR*/*MOD*/wraith.al | |
388 | *DIR*/*MOD*/flying_pig.al | |
389 | ## Tests | |
390 | is (&*MOD*::ghoul, "wail", "still haunted"); | |
391 | is (&*MOD*::zombie, "You didn't use fire.", "Are our zombies still undead?"); | |
975263bc | 392 | ## Sleep |
6ed07066 | 393 | 4 |
81ba8d96 NC |
394 | ## SameAgain |
395 | True, so don't scrub this directory. | |
396 | ################################################################ | |
397 | ## Name | |
d1be9408 | 398 | With the timestamp check make sure that things happen (stuff gets deleted) |
81ba8d96 NC |
399 | ## Extra |
400 | 0, 1, 0 | |
401 | ## Get | |
88e878ad | 402 | AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*) |
81ba8d96 NC |
403 | ## Require |
404 | *MOD*/autosplit.ix | |
405 | ## Files | |
406 | *DIR*/*MOD*/autosplit.ix | |
407 | *DIR*/*MOD*/ghost.al | |
408 | *DIR*/*MOD*/wraith.al | |
409 | ## Tests | |
410 | is (&*MOD*::wraith, 9); | |
ea071790 | 411 | eval {&*MOD*::flying_pig}; ok ($@ =~ m!^Can't locate auto/*MOD*/flying_pig.al in \@INC!, "There are no flying pigs") or print "# \$\@='$@'\n"; |