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