This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
AutoSplit.t now passes (partialy) on Win32
[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
88e878ad
NK
48my $pathsep = $^O eq 'MSWin32' ? '\\' : '/';
49
81ba8d96
NC
50sub split_a_file {
51 my $contents = shift;
52 my $file = $_[0];
53 if (defined $contents) {
54 open FILE, ">$file" or die "Can't open $file: $!";
55 print FILE $contents;
56 close FILE or die "Can't close $file: $!";
57 }
58
59 # Assumption: no characters in arguments need escaping from the shell or perl
60 my $com = qq($runperl -e "use AutoSplit; autosplit (qw(@_))");
88e878ad 61 print "# command: $com\n";
81ba8d96
NC
62 # There may be a way to capture STDOUT without spawning a child process, but
63 # it's probably worthwhile spawning, as it ensures that nothing in AutoSplit
64 # can load functions from split modules into this perl.
65 my $output = `$com`;
66 warn "Exit status $? from running: >>$com<<" if $?;
67 return $output;
68}
69
64a3d80f
CB
70# Brackets are valid in VMS filespecs and this test puts filespecs
71# into regexes a lot.
72
73sub _escape_brackets {
74 my $str = shift;
75 $str =~ s/\[/\\\[/g;
76 $str =~ s/\]/\\\]/g;
77 return $str;
78}
79
81ba8d96 80my $i = 0;
64a3d80f
CB
81my $dir = File::Spec->catdir($incdir, 'auto');
82if ($^O eq 'VMS') {
83 $dir = VMS::Filespec::unixify($dir);
84 $dir =~ s/\/$//;
85}
81ba8d96
NC
86foreach (@tests) {
87 my $module = 'A' . $i . '_' . $$ . 'splittest';
88 my $file = File::Spec->catfile($incdir,"$module.pm");
89 s/\*INC\*/$incdir/gm;
90 s/\*DIR\*/$dir/gm;
91 s/\*MOD\*/$module/gm;
88e878ad 92 s/\*PATHSEP\*/$pathsep/gm;
64a3d80f 93 s#//#/#gm;
81ba8d96
NC
94 # Build a hash for this test.
95 my %args = /^\#\#\ ([^\n]*)\n # Key is on a line starting ##
96 ((?:[^\#]+ # Any number of characters not #
97 | \#(?!\#) # or a # character not followed by #
98 | (?<!\n)\# # or a # character not preceded by \n
99 )*)/sgmx;
a94ed19d 100 foreach ($args{Name}, $args{Require}, $args{Extra}) {
81ba8d96
NC
101 chomp $_ if defined $_;
102 }
103 my @extra_args = !defined $args{Extra} ? () : split /,/, $args{Extra};
104 my ($output, $body);
105 if ($args{File}) {
106 $body ="package $module;\n" . $args{File};
107 $output = split_a_file ($body, $file, $dir, @extra_args);
108 } else {
109 # Repeat tests
110 $output = split_a_file (undef, $file, $dir, @extra_args);
111 }
112
64a3d80f
CB
113 if ($^O eq 'VMS') {
114 my ($filespec, $replacement);
115 while ($output =~ m/(\[.+\])/) {
116 $filespec = $1;
117 $replacement = VMS::Filespec::unixify($filespec);
118 $filespec = _escape_brackets($filespec);
119 $replacement =~ s/\/$//;
120 $output =~ s/$filespec/$replacement/;
121 }
122 }
123
81ba8d96
NC
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 /^#/;
64a3d80f 133 $_ = lc($_) if $^O eq 'VMS';
81ba8d96
NC
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 my $com = 'require "' . File::Spec->catfile ('auto', $args{Require}) . '"';
88e878ad 153 $com =~ s{\\}{/}gm if ($^O eq 'MSWin32');
81ba8d96
NC
154 eval $com;
155 # test n+3
156 ok ($@ eq '', $com) or print "# \$\@ = '$@'\n";
157 if (defined $body) {
158 eval $body or die $@;
159 }
160 }
161 # match tests to check for prototypes
162 if ($args{Match}) {
163 local $/;
164 my $file = File::Spec->catfile($dir, $args{Require});
165 open IX, $file or die "Can't open '$file': $!";
166 my $ix = <IX>;
167 close IX or die "Can't close '$file': $!";
168 foreach my $pat (split /\n/, $args{Match}) {
169 next if $pat =~ /^\#/;
170 like ($ix, qr/^\s*$pat\s*$/m, "match $pat");
171 }
172 }
173 # code tests contain eval{}ed ok()s etc
174 if ($args{Tests}) {
175 foreach my $code (split /\n/, $args{Tests}) {
176 next if $code =~ /^\#/;
64a3d80f 177 $code =~ s/\[(File::Spec->catfile\(.*\))\]/[_escape_brackets($1)]/ if $^O eq 'VMS';
81ba8d96
NC
178 defined eval $code or fail(), print "# Code: $code\n# Error: $@";
179 }
180 }
975263bc
NC
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 }
81ba8d96
NC
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.
88e878ad
NK
232AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*)
233*INC**PATHSEP**MOD*.pm: some names are not unique when truncated to 8 characters:
234 directory *DIR**PATHSEP**MOD*:
81ba8d96 235 testtesttesttest4_1.al, testtesttesttest4_2.al truncate to testtest
88e878ad 236 directory *DIR**PATHSEP*Yet*PATHSEP*Another*PATHSEP*AutoSplit:
81ba8d96
NC
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
88e878ad 272like (&*MOD*::test6, qr!^*INC**PATHSEP**MOD*.pm \(autosplit into @{[File::Spec->catfile('*DIR*','*MOD*', 'test6.al')]}\):\d+$!);
81ba8d96
NC
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
88e878ad 292AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*)
81ba8d96
NC
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 {my $a if 0; return $a++;}
305sub gonner {warn "This gonner function should never get called"}
306## Get
88e878ad 307AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*)
81ba8d96
NC
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);
975263bc
NC
317## Sleep
3182
81ba8d96
NC
319## SameAgain
320True, so don't scrub this directory.
81ba8d96
NC
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
88e878ad 335AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*)
81ba8d96
NC
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";
975263bc
NC
348## Sleep
3492
81ba8d96
NC
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
88e878ad 364AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*)
81ba8d96
NC
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?");
975263bc
NC
378## Sleep
3792
81ba8d96
NC
380## SameAgain
381True, so don't scrub this directory.
382################################################################
383## Name
384Without the 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?");
975263bc
NC
400## Sleep
4012
81ba8d96
NC
402## SameAgain
403True, so don't scrub this directory.
404################################################################
405## Name
406With the the timestamp check make sure that things happen (stuff gets deleted)
407## Extra
4080, 1, 0
409## Get
88e878ad 410AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*)
81ba8d96
NC
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";