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