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 # Brackets are valid in VMS filespecs and this test puts filespecs
  71 # into regexes a lot.
  72
  73 sub _escape_brackets {
  74   my $str = shift;
  75   $str =~ s/\[/\\\[/g;
  76   $str =~ s/\]/\\\]/g;
  77   return $str;
  78 }
  79
  80 my $i = 0;
  81 my $dir = File::Spec->catdir($incdir, 'auto');
  82 if ($^O eq 'VMS') {
  83   $dir = VMS::Filespec::unixify($dir);
  84   $dir =~ s/\/$//;
  85 }
  86 foreach (@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;
  92   s/\*PATHSEP\*/$pathsep/gm;
  93   s#//#/#gm;
  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;
 100   foreach ($args{Name}, $args{Require}, $args{Extra}) {
 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
 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
 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 /^#/;
 133       $_ = lc($_) if $^O eq 'VMS';
 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}) . '"';
 153     $com =~ s{\\}{/}gm if ($^O eq 'MSWin32');
 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 =~ /^\#/;
 177       $code =~ s/\[(File::Spec->catfile\(.*\))\]/[_escape_brackets($1)]/ if $^O eq 'VMS';
 178       defined eval $code or fail(), print "# Code:  $code\n# Error: $@";
 179     }
 180   }
 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.
 195 EOM
 196     }
 197   }
 198   unless ($args{SameAgain}) {
 199     $i++;
 200     rmtree($dir);
 201     mkdir $dir, 0775;
 202   }
 203 }
 204
 205 __DATA__
 206 ## Name
 207 tests from the end of the AutoSplit module.
 208 ## File
 209 use AutoLoader 'AUTOLOAD';
 210 {package Just::Another;
 211  use AutoLoader 'AUTOLOAD';
 212 }
 213 @Yet::Another::AutoSplit::ISA = 'AutoLoader';
 214 1;
 215 __END__
 216 sub test1 ($)   { "test 1"; }
 217 sub test2 ($$)  { "test 2"; }
 218 sub test3 ($$$) { "test 3"; }
 219 sub testtesttesttest4_1  { "test 4"; }
 220 sub testtesttesttest4_2  { "duplicate test 4"; }
 221 sub Just::Another::test5 { "another test 5"; }
 222 sub test6       { return join ":", __FILE__,__LINE__; }
 223 package Yet::Another::AutoSplit;
 224 sub testtesttesttest4_1 ($)  { "another test 4"; }
 225 sub testtesttesttest4_2 ($$) { "another duplicate test 4"; }
 226 package Yet::More::Attributes;
 227 sub test_a1 ($) : locked :locked { 1; }
 228 sub test_a2 : locked { 1; }
 229 # And that was all it has. You were expected to manually inspect the output
 230 ## Get
 231 Warning: AutoSplit had to create top-level *DIR* unexpectedly.
 232 AutoSplitting *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*:
 235   testtesttesttest4_1.al, testtesttesttest4_2.al truncate to testtest
 236  directory *DIR**PATHSEP*Yet*PATHSEP*Another*PATHSEP*AutoSplit:
 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
 255 sub test1\s*\(\$\);
 256 sub test2\s*\(\$\$\);
 257 sub test3\s*\(\$\$\$\);
 258 sub testtesttesttest4_1\s*\(\$\);
 259 sub testtesttesttest4_2\s*\(\$\$\);
 260 sub test_a1\s*\(\$\)\s*:\s*locked\s*:\s*locked\s*;
 261 sub test_a2\s*:\s*locked\s*;
 262 ## Tests
 263 is (*MOD*::test1 (1), 'test 1');
 264 is (*MOD*::test2 (1,2), 'test 2');
 265 is (*MOD*::test3 (1,2,3), 'test 3');
 266 ok (!defined eval "*MOD*::test1 () eq 'test 1'" and $@ =~ /^Not enough arguments for *MOD*::test1/, "Check prototypes mismatch fails") or print "# \$\@='$@'";
 267 is (&*MOD*::testtesttesttest4_1, "test 4");
 268 is (&*MOD*::testtesttesttest4_2, "duplicate test 4");
 269 is (&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
 272 like (&*MOD*::test6, qr!^\Q*INC**PATHSEP**MOD*\E\.pm \(autosplit into \Q@{[File::Spec->catfile('*DIR*','*MOD*', 'test6.al')]}\E\):\d+$!);
 273 ok (Yet::Another::AutoSplit->testtesttesttest4_1 eq "another test 4");
 274 ################################################################
 275 ## Name
 276 missing use AutoLoader;
 277 ## File
 278 1;
 279 __END__
 280 ## Get
 281 ## Files
 282 # There should be no files.
 283 ################################################################
 284 ## Name
 285 missing use AutoLoader; (but don't skip)
 286 ## Extra
 287 0, 0
 288 ## File
 289 1;
 290 __END__
 291 ## Get
 292 AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*)
 293 ## Require
 294 *MOD*/autosplit.ix
 295 ## Files
 296 *DIR*/*MOD*/autosplit.ix
 297 ################################################################
 298 ## Name
 299 Split prior to checking whether obsolete files get deleted
 300 ## File
 301 use AutoLoader 'AUTOLOAD';
 302 1;
 303 __END__
 304 sub obsolete {my $a if 0; return $a++;}
 305 sub gonner {warn "This gonner function should never get called"}
 306 ## Get
 307 AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*)
 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
 315 is (&*MOD*::obsolete, 0);
 316 is (&*MOD*::obsolete, 1);
 317 ## Sleep
 318 2
 319 ## SameAgain
 320 True, so don't scrub this directory.
 321 IIRC DOS FAT filesystems have only 2 second granularity.
 322 ################################################################
 323 ## Name
 324 Check whether obsolete files get deleted
 325 ## File
 326 use AutoLoader 'AUTOLOAD';
 327 1;
 328 __END__
 329 sub skeleton {"bones"};
 330 sub ghost {"scream"}; # This definition gets overwritten with the one below
 331 sub ghoul {"wail"};
 332 sub zombie {"You didn't use fire."};
 333 sub flying_pig {"Oink oink flap flap"};
 334 ## Get
 335 AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*)
 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
 346 is (&*MOD*::skeleton, "bones", "skeleton");
 347 eval {&*MOD*::gonner}; ok ($@ =~ m!^Can't locate auto/*MOD*/gonner.al in \@INC!, "Check &*MOD*::gonner is now a gonner") or print "# \$\@='$@'\n";
 348 ## Sleep
 349 2
 350 ## SameAgain
 351 True, so don't scrub this directory.
 352 ################################################################
 353 ## Name
 354 Check whether obsolete files remain when keep is 1
 355 ## Extra
 356 1, 1
 357 ## File
 358 use AutoLoader 'AUTOLOAD';
 359 1;
 360 __END__
 361 sub ghost {"bump"};
 362 sub wraith {9};
 363 ## Get
 364 AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*)
 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
 376 is (&*MOD*::ghost, "bump");
 377 is (&*MOD*::zombie, "You didn't use fire.", "Are our zombies undead?");
 378 ## Sleep
 379 2
 380 ## SameAgain
 381 True, so don't scrub this directory.
 382 ################################################################
 383 ## Name
 384 Without the the timestamp check make sure that nothing happens
 385 ## Extra
 386 0, 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
 398 is (&*MOD*::ghoul, "wail", "still haunted");
 399 is (&*MOD*::zombie, "You didn't use fire.", "Are our zombies still undead?");
 400 ## Sleep
 401 2
 402 ## SameAgain
 403 True, so don't scrub this directory.
 404 ################################################################
 405 ## Name
 406 With the the timestamp check make sure that things happen (stuff gets deleted)
 407 ## Extra
 408 0, 1, 0
 409 ## Get
 410 AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD*)
 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
 418 is (&*MOD*::wraith, 9);
 419 eval {&*MOD*::flying_pig}; ok ($@ =~ m!^Can't locate auto/*MOD*/flying_pig.al in \@INC!, "There are no flying pigs") or print "# \$\@='$@'\n";