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