This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
AutoSplit.t (was Re: Untested libraries update)
[perl5.git] / lib / AutoSplit.t
CommitLineData
81ba8d96
NC
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;
82 foreach ($args{Name}, $args{Require}) {
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 }
149 unless ($args{SameAgain}) {
150 $i++;
151 rmtree($dir);
152 mkdir $dir, 0775;
153 }
154}
155
156__DATA__
157## Name
158tests from the end of the AutoSplit module.
159## File
160use AutoLoader 'AUTOLOAD';
161{package Just::Another;
162 use AutoLoader 'AUTOLOAD';
163}
164@Yet::Another::AutoSplit::ISA = 'AutoLoader';
1651;
166__END__
167sub test1 ($) { "test 1"; }
168sub test2 ($$) { "test 2"; }
169sub test3 ($$$) { "test 3"; }
170sub testtesttesttest4_1 { "test 4"; }
171sub testtesttesttest4_2 { "duplicate test 4"; }
172sub Just::Another::test5 { "another test 5"; }
173sub test6 { return join ":", __FILE__,__LINE__; }
174package Yet::Another::AutoSplit;
175sub testtesttesttest4_1 ($) { "another test 4"; }
176sub testtesttesttest4_2 ($$) { "another duplicate test 4"; }
177package Yet::More::Attributes;
178sub test_a1 ($) : locked :locked { 1; }
179sub test_a2 : locked { 1; }
180# And that was all it has. You were expected to manually inspect the output
181## Get
182Warning: AutoSplit had to create top-level *DIR* unexpectedly.
183AutoSplitting *INC*/*MOD*.pm (*DIR*/*MOD*)
184*INC*/*MOD*.pm: some names are not unique when truncated to 8 characters:
185 directory *DIR*/*MOD*:
186 testtesttesttest4_1.al, testtesttesttest4_2.al truncate to testtest
187 directory *DIR*/Yet/Another/AutoSplit:
188 testtesttesttest4_1.al, testtesttesttest4_2.al truncate to testtest
189## Files
190*DIR*/*MOD*/autosplit.ix
191*DIR*/*MOD*/test1.al
192*DIR*/*MOD*/test2.al
193*DIR*/*MOD*/test3.al
194*DIR*/*MOD*/testtesttesttest4_1.al
195*DIR*/*MOD*/testtesttesttest4_2.al
196*DIR*/Just/Another/test5.al
197*DIR*/*MOD*/test6.al
198*DIR*/Yet/Another/AutoSplit/testtesttesttest4_1.al
199*DIR*/Yet/Another/AutoSplit/testtesttesttest4_2.al
200*DIR*/Yet/More/Attributes/test_a1.al
201*DIR*/Yet/More/Attributes/test_a2.al
202## Require
203*MOD*/autosplit.ix
204## Match
205# Need to find these lines somewhere in the required file
206sub test1\s*\(\$\);
207sub test2\s*\(\$\$\);
208sub test3\s*\(\$\$\$\);
209sub testtesttesttest4_1\s*\(\$\);
210sub testtesttesttest4_2\s*\(\$\$\);
211sub test_a1\s*\(\$\)\s*:\s*locked\s*:\s*locked\s*;
212sub test_a2\s*:\s*locked\s*;
213## Tests
214is (*MOD*::test1 (1), 'test 1');
215is (*MOD*::test2 (1,2), 'test 2');
216is (*MOD*::test3 (1,2,3), 'test 3');
217ok (!defined eval "*MOD*::test1 () eq 'test 1'" and $@ =~ /^Not enough arguments for *MOD*::test1/, "Check prototypes mismatch fails") or print "# \$\@='$@'";
218is (&*MOD*::testtesttesttest4_1, "test 4");
219is (&*MOD*::testtesttesttest4_2, "duplicate test 4");
220is (&Just::Another::test5, "another test 5");
221# very messy way to interpolate function into regexp, but it's going to be
222# needed to get : for Mac filespecs
223like (&*MOD*::test6, qr!^*INC*/*MOD*.pm \(autosplit into @{[File::Spec->catfile('*DIR*','*MOD*', 'test6.al')]}\):\d+$!);
224ok (Yet::Another::AutoSplit->testtesttesttest4_1 eq "another test 4");
225################################################################
226## Name
227missing use AutoLoader;
228## File
2291;
230__END__
231## Get
232## Files
233# There should be no files.
234################################################################
235## Name
236missing use AutoLoader; (but don't skip)
237## Extra
2380, 0
239## File
2401;
241__END__
242## Get
243AutoSplitting *INC*/*MOD*.pm (*DIR*/*MOD*)
244## Require
245*MOD*/autosplit.ix
246## Files
247*DIR*/*MOD*/autosplit.ix
248################################################################
249## Name
250Split prior to checking whether obsolete files get deleted
251## File
252use AutoLoader 'AUTOLOAD';
2531;
254__END__
255sub obsolete {my $a if 0; return $a++;}
256sub gonner {warn "This gonner function should never get called"}
257## Get
258AutoSplitting *INC*/*MOD*.pm (*DIR*/*MOD*)
259## Require
260*MOD*/autosplit.ix
261## Files
262*DIR*/*MOD*/autosplit.ix
263*DIR*/*MOD*/gonner.al
264*DIR*/*MOD*/obsolete.al
265## Tests
266is (&*MOD*::obsolete, 0);
267is (&*MOD*::obsolete, 1);
268{my $time = time; print "# time is $time\n"; sleep (2); sleep (2) unless time > $time + 1}
269printf "# time is %d (hopefully >=2 seconds later)\n", time;
270## SameAgain
271True, so don't scrub this directory.
272Need the sleep hack else the next test is so fast that the timestamp compare
273routine in AutoSplit thinks that it shouldn't split the files.
274IIRC DOS FAT filesystems have only 2 second granularity.
275################################################################
276## Name
277Check whether obsolete files get deleted
278## File
279use AutoLoader 'AUTOLOAD';
2801;
281__END__
282sub skeleton {"bones"};
283sub ghost {"scream"}; # This definition gets overwritten with the one below
284sub ghoul {"wail"};
285sub zombie {"You didn't use fire."};
286sub flying_pig {"Oink oink flap flap"};
287## Get
288AutoSplitting *INC*/*MOD*.pm (*DIR*/*MOD*)
289## Require
290*MOD*/autosplit.ix
291## Files
292*DIR*/*MOD*/autosplit.ix
293*DIR*/*MOD*/skeleton.al
294*DIR*/*MOD*/zombie.al
295*DIR*/*MOD*/ghost.al
296*DIR*/*MOD*/ghoul.al
297*DIR*/*MOD*/flying_pig.al
298## Tests
299is (&*MOD*::skeleton, "bones", "skeleton");
300eval {&*MOD*::gonner}; ok ($@ =~ m!^Can't locate auto/*MOD*/gonner.al in \@INC!, "Check &*MOD*::gonner is now a gonner") or print "# \$\@='$@'\n";
301{my $time = time; print "# time is $time\n"; sleep (2); sleep (2) unless time > $time + 1}
302printf "# time is %d (hopefully >=2 seconds later)\n", time;
303## SameAgain
304True, so don't scrub this directory.
305################################################################
306## Name
307Check whether obsolete files remain when keep is 1
308## Extra
3091, 1
310## File
311use AutoLoader 'AUTOLOAD';
3121;
313__END__
314sub ghost {"bump"};
315sub wraith {9};
316## Get
317AutoSplitting *INC*/*MOD*.pm (*DIR*/*MOD*)
318## Require
319*MOD*/autosplit.ix
320## Files
321*DIR*/*MOD*/autosplit.ix
322*DIR*/*MOD*/skeleton.al
323*DIR*/*MOD*/zombie.al
324*DIR*/*MOD*/ghost.al
325*DIR*/*MOD*/ghoul.al
326*DIR*/*MOD*/wraith.al
327*DIR*/*MOD*/flying_pig.al
328## Tests
329is (&*MOD*::ghost, "bump");
330is (&*MOD*::zombie, "You didn't use fire.", "Are our zombies undead?");
331{my $time = time; print "# time is $time\n"; sleep (2); sleep (2) unless time > $time + 1}
332printf "# time is %d (hopefully >=2 seconds later)\n", time;
333## SameAgain
334True, so don't scrub this directory.
335################################################################
336## Name
337Without the the timestamp check make sure that nothing happens
338## Extra
3390, 1, 1
340## Require
341*MOD*/autosplit.ix
342## Files
343*DIR*/*MOD*/autosplit.ix
344*DIR*/*MOD*/skeleton.al
345*DIR*/*MOD*/zombie.al
346*DIR*/*MOD*/ghost.al
347*DIR*/*MOD*/ghoul.al
348*DIR*/*MOD*/wraith.al
349*DIR*/*MOD*/flying_pig.al
350## Tests
351is (&*MOD*::ghoul, "wail", "still haunted");
352is (&*MOD*::zombie, "You didn't use fire.", "Are our zombies still undead?");
353{my $time = time; print "# time is $time\n"; sleep (2); sleep (2) unless time > $time + 1}
354printf "# time is %d (hopefully >=2 seconds later)\n", time;
355## SameAgain
356True, so don't scrub this directory.
357################################################################
358## Name
359With the the timestamp check make sure that things happen (stuff gets deleted)
360## Extra
3610, 1, 0
362## Get
363AutoSplitting *INC*/*MOD*.pm (*DIR*/*MOD*)
364## Require
365*MOD*/autosplit.ix
366## Files
367*DIR*/*MOD*/autosplit.ix
368*DIR*/*MOD*/ghost.al
369*DIR*/*MOD*/wraith.al
370## Tests
371is (&*MOD*::wraith, 9);
372eval {&*MOD*::flying_pig}; ok ($@ =~ m!^Can't locate auto/*MOD*/flying_pig.al in \@INC!, "There are no flying pigs") or print "# \$\@='$@'\n";