This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
This test is not very robust on 8.3-constrained systems:
[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;
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 'dos') {
11         print "1..0 # This test is not 8.3-aware.\n";
12             exit 0;
13     }
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
52 my $pathsep = $^O eq 'MSWin32' ? '\\' : '/';
53  
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(@_))");
65   print "# command: $com\n";
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;
75 my $dir = File::Spec->catdir($incdir, 'auto');
76 if ($^O eq 'VMS') {
77   $dir = VMS::Filespec::unixify($dir);
78   $dir =~ s/\/$//;
79 }
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;
86   s/\*PATHSEP\*/$pathsep/gm;
87   s#//#/#gm;
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;
94   foreach ($args{Name}, $args{Require}, $args{Extra}) {
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
107   if ($^O eq 'VMS') {
108      my ($filespec, $replacement);
109      while ($output =~ m/(\[.+\])/) {
110        $filespec = $1;
111        $replacement =  VMS::Filespec::unixify($filespec);
112        $replacement =~ s/\/$//;
113        $output =~ s/\Q$filespec\E/$replacement/;
114      }
115   }
116
117   # test n+1
118   is ($output, $args{Get}, "Output from autosplit()ing $args{Name}");
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 /^#/;
126       $_ = lc($_) if $^O eq 'VMS';
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}) . '"';
146     $com =~ s{\\}{/}gm if ($^O eq 'MSWin32');
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   }
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   }
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.
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*:
227   testtesttesttest4_1.al, testtesttesttest4_2.al truncate to testtest
228  directory *DIR**PATHSEP*Yet*PATHSEP*Another*PATHSEP*AutoSplit:
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
264 like (&*MOD*::test6, qr!^\Q*INC**PATHSEP**MOD*\E\.pm \(autosplit into \Q@{[File::Spec->catfile('*DIR*','*MOD*', 'test6.al')]}\E\):\d+$!);
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
284 AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*)
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
299 AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*)
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);
309 ## Sleep
310 2
311 ## SameAgain
312 True, so don't scrub this directory.
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
327 AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*)
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");
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";
340 ## Sleep
341 2
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
356 AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*)
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?");
370 ## Sleep
371 2
372 ## SameAgain
373 True, so don't scrub this directory.
374 ################################################################
375 ## Name
376 Without the timestamp check make sure that nothing happens
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?");
392 ## Sleep
393 2
394 ## SameAgain
395 True, so don't scrub this directory.
396 ################################################################
397 ## Name
398 With the timestamp check make sure that things happen (stuff gets deleted)
399 ## Extra
400 0, 1, 0
401 ## Get
402 AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*)
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);
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";