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