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