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