1#!./perl -w
2
3# AutoLoader.t runs before this test, so it seems safe to assume that it will
4# work.
5
6my($incdir, $lib);
7BEGIN {
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}
23my $runperl = "$^X $lib";
24
25use warnings;
26use strict;
27use Test::More tests => 58;
28use File::Spec;
29use File::Find;
30
31require AutoSplit; # Run time. Check it compiles.
32ok (1, "AutoSplit loaded");
33
34END {
35    use File::Path;
36    print "# $incdir being removed...\n";
37    rmtree($incdir);
38}
39
40mkdir $incdir,0755;
41
42my @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
52my $pathsep = $^O eq 'MSWin32' ? '\\' : $^O eq 'MacOS' ? ':' : '/';
53my $endpathsep = $^O eq 'MacOS' ? ':' : '';
54
55sub 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
75my $i = 0;
76my $dir = File::Spec->catdir($incdir, 'auto');
77if ($^O eq 'VMS') {
78  $dir = VMS::Filespec::unixify($dir);
79  $dir =~ s/\/$//;
80} elsif ($^O eq 'MacOS') {
81  $dir =~ s/:$//;
82}
83
84foreach (@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  $args{Get} ||= '';
103
104  my @extra_args = !defined $args{Extra} ? () : split /,/, $args{Extra};
105  my ($output, $body);
106  if ($args{File}) {
107    $body ="package $module;\n" . $args{File};
108    $output = split_a_file ($body, $file, $dir, @extra_args);
109  } else {
110    # Repeat tests
111    $output = split_a_file (undef, $file, $dir, @extra_args);
112  }
113
114  if ($^O eq 'VMS') {
115     my ($filespec, $replacement);
116     while ($output =~ m/(\[.+\])/) {
117       $filespec = $1;
118       $replacement =  VMS::Filespec::unixify($filespec);
119       $replacement =~ s/\/$//;
120       $output =~ s/\Q$filespec\E/$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    $args{Require} =~ s|/|:|gm if $^O eq 'MacOS';
153    my $com = 'require "' . File::Spec->catfile ('auto', $args{Require}) . '"';
154    $com =~ s{\\}{/}gm if ($^O eq 'MSWin32');
155    eval $com;
156    # test n+3
157    ok ($@ eq '', $com) or print "# \$\@ = '$@'\n";
158    if (defined $body) {
159      eval $body or die $@;
160    }
161  }
162  # match tests to check for prototypes
163  if ($args{Match}) {
164    local $/;
165    my $file = File::Spec->catfile($dir, $args{Require});
166    open IX, $file or die "Can't open '$file': $!";
167    my $ix = <IX>;
168    close IX or die "Can't close '$file': $!";
169    foreach my $pat (split /\n/, $args{Match}) {
170      next if $pat =~ /^\#/;
171      like ($ix, qr/^\s*$pat\s*$/m, "match $pat");
172    }
173  }
174  # code tests contain eval{}ed ok()s etc
175  if ($args{Tests}) {
176    foreach my $code (split /\n/, $args{Tests}) {
177      next if $code =~ /^\#/;
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.
195EOM
196    }
197  }
198  unless ($args{SameAgain}) {
199    $i++;
200    rmtree($dir);
201    mkdir $dir, 0775;
202  }
203}
204
205__DATA__
206## Name
207tests from the end of the AutoSplit module.
208## File
209use AutoLoader 'AUTOLOAD';
210{package Just::Another;
211 use AutoLoader 'AUTOLOAD';
212}
213@Yet::Another::AutoSplit::ISA = 'AutoLoader';
2141;
215__END__
216sub test1 ($)   { "test 1"; }
217sub test2 ($$)  { "test 2"; }
218sub test3 ($$$) { "test 3"; }
219sub testtesttesttest4_1  { "test 4"; }
220sub testtesttesttest4_2  { "duplicate test 4"; }
221sub Just::Another::test5 { "another test 5"; }
222sub test6       { return join ":", __FILE__,__LINE__; }
223package Yet::Another::AutoSplit;
224sub testtesttesttest4_1 ($)  { "another test 4"; }
225sub testtesttesttest4_2 ($$) { "another duplicate test 4"; }
226package Yet::More::Attributes;
227sub test_a1 ($) : locked :locked { 1; }
228sub test_a2 : locked { 1; }
229# And that was all it has. You were expected to manually inspect the output
230## Get
231Warning: AutoSplit had to create top-level *DIR* unexpectedly.
232AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*)
233*INC**PATHSEP**MOD*.pm: some names are not unique when truncated to 8 characters:
234 directory *DIR**PATHSEP**MOD**ENDPATHSEP*:
235  testtesttesttest4_1.al, testtesttesttest4_2.al truncate to testtest
236 directory *DIR**PATHSEP*Yet*PATHSEP*Another*PATHSEP*AutoSplit*ENDPATHSEP*:
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
255sub test1\s*\(\$\);
256sub test2\s*\(\$\$\);
257sub test3\s*\(\$\$\$\);
258sub testtesttesttest4_1\s*\(\$\);
259sub testtesttesttest4_2\s*\(\$\$\);
260sub test_a1\s*\(\$\)\s*:\s*locked\s*:\s*locked\s*;
261sub test_a2\s*:\s*locked\s*;
262## Tests
263is (*MOD*::test1 (1), 'test 1');
264is (*MOD*::test2 (1,2), 'test 2');
265is (*MOD*::test3 (1,2,3), 'test 3');
266ok (!defined eval "*MOD*::test1 () eq 'test 1'" and $@ =~ /^Not enough arguments for *MOD*::test1/, "Check prototypes mismatch fails") or print "# \$\@='$@'";
267is (&*MOD*::testtesttesttest4_1, "test 4");
268is (&*MOD*::testtesttesttest4_2, "duplicate test 4");
269is (&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
272like (&*MOD*::test6, qr!^\Q*INC**PATHSEP**MOD*\E\.pm \(autosplit into \Q@{[File::Spec->catfile('*DIR*','*MOD*', 'test6.al')]}\E\):\d+$!);
273ok (Yet::Another::AutoSplit->testtesttesttest4_1 eq "another test 4");
274################################################################
275## Name
276missing use AutoLoader;
277## File
2781;
279__END__
280## Get
281## Files
282# There should be no files.
283################################################################
284## Name
285missing use AutoLoader; (but don't skip)
286## Extra
2870, 0
288## File
2891;
290__END__
291## Get
292AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*)
293## Require
294*MOD*/autosplit.ix
295## Files
296*DIR*/*MOD*/autosplit.ix
297################################################################
298## Name
299Split prior to checking whether obsolete files get deleted
300## File
301use AutoLoader 'AUTOLOAD';
3021;
303__END__
304sub obsolete {our $hidden_a; return $hidden_a++;}
305sub gonner {warn "This gonner function should never get called"}
306## Get
307AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*)
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
315is (&*MOD*::obsolete, 0);
316is (&*MOD*::obsolete, 1);
317## Sleep
3184
319## SameAgain
320True, so don't scrub this directory.
321IIRC DOS FAT filesystems have only 2 second granularity.
322################################################################
323## Name
324Check whether obsolete files get deleted
325## File
326use AutoLoader 'AUTOLOAD';
3271;
328__END__
329sub skeleton {"bones"};
330sub ghost {"scream"}; # This definition gets overwritten with the one below
331sub ghoul {"wail"};
332sub zombie {"You didn't use fire."};
333sub flying_pig {"Oink oink flap flap"};
334## Get
335AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*)
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
346is (&*MOD*::skeleton, "bones", "skeleton");
347eval {&*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
3494
350## SameAgain
351True, so don't scrub this directory.
352################################################################
353## Name
354Check whether obsolete files remain when keep is 1
355## Extra
3561, 1
357## File
358use AutoLoader 'AUTOLOAD';
3591;
360__END__
361sub ghost {"bump"};
362sub wraith {9};
363## Get
364AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*)
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
376is (&*MOD*::ghost, "bump");
377is (&*MOD*::zombie, "You didn't use fire.", "Are our zombies undead?");
378## Sleep
3794
380## SameAgain
381True, so don't scrub this directory.
382################################################################
383## Name
384Without the timestamp check make sure that nothing happens
385## Extra
3860, 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
398is (&*MOD*::ghoul, "wail", "still haunted");
399is (&*MOD*::zombie, "You didn't use fire.", "Are our zombies still undead?");
400## Sleep
4014
402## SameAgain
403True, so don't scrub this directory.
404################################################################
405## Name
406With the timestamp check make sure that things happen (stuff gets deleted)
407## Extra
4080, 1, 0
409## Get
410AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*)
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
418is (&*MOD*::wraith, 9);
419eval {&*MOD*::flying_pig}; ok ($@ =~ m!^Can't locate auto/*MOD*/flying_pig.al in \@INC!, "There are no flying pigs") or print "# \$\@='$@'\n";
420