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