lib/AutoSplit.t

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