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