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 $args{Files} =~ s!\\!/!g if $^O eq 'MSWin32'; 153 my (%missing, %got); 154 find( 155 sub { (my $f = $File::Find::name) =~ s!\\!/!g; $got{$f}++ unless -d $_ }, 156 $dir 157 ); 158 foreach (split /\n/, $args{Files}) { 159 next if /^#/; 160 $_ = lc($_) if $Is_VMS_lc; 161 unless (delete $got{$_}) { 162 $missing{$_}++; 163 } 164 } 165 my @missing = keys %missing; 166 # test n+2 167 unless (ok (!@missing, "Are any expected files missing?")) { 168 print "# These files are missing\n"; 169 print "# $_\n" foreach sort @missing; 170 } 171 my @extra = keys %got; 172 # test n+3 173 unless (ok (!@extra, "Are any extra files present?")) { 174 print "# These files are unexpectedly present:\n"; 175 print "# $_\n" foreach sort @extra; 176 } 177 } 178 if ($args{Require}) { 179 $args{Require} =~ s|/|:|gm if $^O eq 'MacOS'; 180 my $com = 'require "' . File::Spec->catfile ('auto', $args{Require}) . '"'; 181 $com =~ s{\\}{/}gm if ($^O eq 'MSWin32'); 182 eval $com; 183 # test n+3 184 ok ($@ eq '', $com) or print "# \$\@ = '$@'\n"; 185 if (defined $body) { 186 eval $body or die $@; 187 } 188 } 189 # match tests to check for prototypes 190 if ($args{Match}) { 191 local $/; 192 my $file = File::Spec->catfile($dir, $args{Require}); 193 open IX, $file or die "Can't open '$file': $!"; 194 my $ix = <IX>; 195 close IX or die "Can't close '$file': $!"; 196 foreach my $pat (split /\n/, $args{Match}) { 197 next if $pat =~ /^\#/; 198 like ($ix, qr/^\s*$pat\s*$/m, "match $pat"); 199 } 200 } 201 # code tests contain eval{}ed ok()s etc 202 if ($args{Tests}) { 203 foreach my $code (split /\n/, $args{Tests}) { 204 next if $code =~ /^\#/; 205 defined eval $code or fail(), print "# Code: $code\n# Error: $@"; 206 } 207 } 208 if (my $sleepfor = $args{Sleep}) { 209 # We need to sleep for a while 210 # Need the sleep hack else the next test is so fast that the timestamp 211 # compare routine in AutoSplit thinks that it shouldn't split the files. 212 my $time = time; 213 my $until = $time + $sleepfor; 214 my $attempts = 3; 215 do { 216 sleep ($sleepfor) 217 } while (time < $until && --$attempts > 0); 218 if ($attempts == 0) { 219 printf << "EOM", time; 220# Attempted to sleep for $sleepfor second(s), started at $time, now %d. 221# sleep attempt ppears to have failed; some tests may fail as a result. 222EOM 223 } 224 } 225 unless ($args{SameAgain}) { 226 $i++; 227 rmtree($dir); 228 mkdir $dir, 0775; 229 } 230} 231 232__DATA__ 233## Name 234tests from the end of the AutoSplit module. 235## File 236use AutoLoader 'AUTOLOAD'; 237{package Just::Another; 238 use AutoLoader 'AUTOLOAD'; 239} 240@Yet::Another::AutoSplit::ISA = 'AutoLoader'; 2411; 242__END__ 243sub test1 ($) { "test 1"; } 244sub test2 ($$) { "test 2"; } 245sub test3 ($$$) { "test 3"; } 246sub testtesttesttest4_1 { "test 4"; } 247sub testtesttesttest4_2 { "duplicate test 4"; } 248sub Just::Another::test5 { "another test 5"; } 249sub test6 { return join ":", __FILE__,__LINE__; } 250package Yet::Another::AutoSplit; 251sub testtesttesttest4_1 ($) { "another test 4"; } 252sub testtesttesttest4_2 ($$) { "another duplicate test 4"; } 253package Yet::More::Attributes; 254sub test_a1 ($) : lvalue :lvalue { 1; } 255sub test_a2 : lvalue { 1; } 256# And that was all it has. You were expected to manually inspect the output 257## Get 258Warning: AutoSplit had to create top-level *DIR* unexpectedly. 259AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) 260*INC**PATHSEP**MOD*.pm: some names are not unique when truncated to 8 characters: 261 directory *DIR**PATHSEP**MOD**ENDPATHSEP*: 262 testtesttesttest4_1.al, testtesttesttest4_2.al truncate to testtest 263 directory *DIR**PATHSEP*Yet*PATHSEP*Another*PATHSEP*AutoSplit*ENDPATHSEP*: 264 testtesttesttest4_1.al, testtesttesttest4_2.al truncate to testtest 265## Files 266*DIR*/*MOD*/autosplit.ix 267*DIR*/*MOD*/test1.al 268*DIR*/*MOD*/test2.al 269*DIR*/*MOD*/test3.al 270*DIR*/*MOD*/testtesttesttest4_1.al 271*DIR*/*MOD*/testtesttesttest4_2.al 272*DIR*/Just/Another/test5.al 273*DIR*/*MOD*/test6.al 274*DIR*/Yet/Another/AutoSplit/testtesttesttest4_1.al 275*DIR*/Yet/Another/AutoSplit/testtesttesttest4_2.al 276*DIR*/Yet/More/Attributes/test_a1.al 277*DIR*/Yet/More/Attributes/test_a2.al 278## Require 279*MOD*/autosplit.ix 280## Match 281# Need to find these lines somewhere in the required file 282sub test1\s*\(\$\); 283sub test2\s*\(\$\$\); 284sub test3\s*\(\$\$\$\); 285sub testtesttesttest4_1\s*\(\$\); 286sub testtesttesttest4_2\s*\(\$\$\); 287sub test_a1\s*\(\$\)\s*:\s*lvalue\s*:\s*lvalue\s*; 288sub test_a2\s*:\s*lvalue\s*; 289## Tests 290is (*MOD*::test1 (1), 'test 1'); 291is (*MOD*::test2 (1,2), 'test 2'); 292is (*MOD*::test3 (1,2,3), 'test 3'); 293ok (!defined eval "*MOD*::test1 () eq 'test 1'" and $@ =~ /^Not enough arguments for *MOD*::test1/, "Check prototypes mismatch fails") or print "# \$\@='$@'"; 294is (&*MOD*::testtesttesttest4_1, "test 4"); 295is (&*MOD*::testtesttesttest4_2, "duplicate test 4"); 296is (&Just::Another::test5, "another test 5"); 297# very messy way to interpolate function into regexp, but it's going to be 298# needed to get : for Mac filespecs 299like (&*MOD*::test6, qr!^\Q*INC**PATHSEP**MOD*\E\.pm \(autosplit into \Q@{[File::Spec->catfile('*DIR*','*MOD*', 'test6.al')]}\E\):\d+$!); 300ok (Yet::Another::AutoSplit->testtesttesttest4_1 eq "another test 4"); 301################################################################ 302## Name 303missing use AutoLoader; 304## File 3051; 306__END__ 307## Get 308## Files 309# There should be no files. 310################################################################ 311## Name 312missing use AutoLoader; (but don't skip) 313## Extra 3140, 0 315## File 3161; 317__END__ 318## Get 319AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) 320## Require 321*MOD*/autosplit.ix 322## Files 323*DIR*/*MOD*/autosplit.ix 324################################################################ 325## Name 326Split prior to checking whether obsolete files get deleted 327## File 328use AutoLoader 'AUTOLOAD'; 3291; 330__END__ 331sub obsolete {our $hidden_a; return $hidden_a++;} 332sub gonner {warn "This gonner function should never get called"} 333## Get 334AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) 335## Require 336*MOD*/autosplit.ix 337## Files 338*DIR*/*MOD*/autosplit.ix 339*DIR*/*MOD*/gonner.al 340*DIR*/*MOD*/obsolete.al 341## Tests 342is (&*MOD*::obsolete, 0); 343is (&*MOD*::obsolete, 1); 344## Sleep 3454 346## SameAgain 347True, so don't scrub this directory. 348IIRC DOS FAT filesystems have only 2 second granularity. 349################################################################ 350## Name 351Check whether obsolete files get deleted 352## File 353use AutoLoader 'AUTOLOAD'; 3541; 355__END__ 356sub skeleton {"bones"}; 357sub ghost {"scream"}; # This definition gets overwritten with the one below 358sub ghoul {"wail"}; 359sub zombie {"You didn't use fire."}; 360sub flying_pig {"Oink oink flap flap"}; 361## Get 362AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) 363## Require 364*MOD*/autosplit.ix 365## Files 366*DIR*/*MOD*/autosplit.ix 367*DIR*/*MOD*/skeleton.al 368*DIR*/*MOD*/zombie.al 369*DIR*/*MOD*/ghost.al 370*DIR*/*MOD*/ghoul.al 371*DIR*/*MOD*/flying_pig.al 372## Tests 373is (&*MOD*::skeleton, "bones", "skeleton"); 374eval {&*MOD*::gonner}; ok ($@ =~ m!^Can't locate auto/*MOD*/gonner.al in \@INC!, "Check &*MOD*::gonner is now a gonner") or print "# \$\@='$@'\n"; 375## Sleep 3764 377## SameAgain 378True, so don't scrub this directory. 379################################################################ 380## Name 381Check whether obsolete files remain when keep is 1 382## Extra 3831, 1 384## File 385use AutoLoader 'AUTOLOAD'; 3861; 387__END__ 388sub ghost {"bump"}; 389sub wraith {9}; 390## Get 391AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) 392## Require 393*MOD*/autosplit.ix 394## Files 395*DIR*/*MOD*/autosplit.ix 396*DIR*/*MOD*/skeleton.al 397*DIR*/*MOD*/zombie.al 398*DIR*/*MOD*/ghost.al 399*DIR*/*MOD*/ghoul.al 400*DIR*/*MOD*/wraith.al 401*DIR*/*MOD*/flying_pig.al 402## Tests 403is (&*MOD*::ghost, "bump"); 404is (&*MOD*::zombie, "You didn't use fire.", "Are our zombies undead?"); 405## Sleep 4064 407## SameAgain 408True, so don't scrub this directory. 409################################################################ 410## Name 411Without the timestamp check make sure that nothing happens 412## Extra 4130, 1, 1 414## Require 415*MOD*/autosplit.ix 416## Files 417*DIR*/*MOD*/autosplit.ix 418*DIR*/*MOD*/skeleton.al 419*DIR*/*MOD*/zombie.al 420*DIR*/*MOD*/ghost.al 421*DIR*/*MOD*/ghoul.al 422*DIR*/*MOD*/wraith.al 423*DIR*/*MOD*/flying_pig.al 424## Tests 425is (&*MOD*::ghoul, "wail", "still haunted"); 426is (&*MOD*::zombie, "You didn't use fire.", "Are our zombies still undead?"); 427## Sleep 4284 429## SameAgain 430True, so don't scrub this directory. 431################################################################ 432## Name 433With the timestamp check make sure that things happen (stuff gets deleted) 434## Extra 4350, 1, 0 436## Get 437AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*) 438## Require 439*MOD*/autosplit.ix 440## Files 441*DIR*/*MOD*/autosplit.ix 442*DIR*/*MOD*/ghost.al 443*DIR*/*MOD*/wraith.al 444## Tests 445is (&*MOD*::wraith, 9); 446eval {&*MOD*::flying_pig}; ok ($@ =~ m!^Can't locate auto/*MOD*/flying_pig.al in \@INC!, "There are no flying pigs") or print "# \$\@='$@'\n"; 447