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