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}) {
  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   unless ($args{SameAgain}) {
 150     $i++;
 151     rmtree($dir);
 152     mkdir $dir, 0775;
 153   }
 154 }
 155
 156 __DATA__
 157 ## Name
 158 tests from the end of the AutoSplit module.
 159 ## File
 160 use AutoLoader 'AUTOLOAD';
 161 {package Just::Another;
 162  use AutoLoader 'AUTOLOAD';
 163 }
 164 @Yet::Another::AutoSplit::ISA = 'AutoLoader';
 165 1;
 166 __END__
 167 sub test1 ($)   { "test 1"; }
 168 sub test2 ($$)  { "test 2"; }
 169 sub test3 ($$$) { "test 3"; }
 170 sub testtesttesttest4_1  { "test 4"; }
 171 sub testtesttesttest4_2  { "duplicate test 4"; }
 172 sub Just::Another::test5 { "another test 5"; }
 173 sub test6       { return join ":", __FILE__,__LINE__; }
 174 package Yet::Another::AutoSplit;
 175 sub testtesttesttest4_1 ($)  { "another test 4"; }
 176 sub testtesttesttest4_2 ($$) { "another duplicate test 4"; }
 177 package Yet::More::Attributes;
 178 sub test_a1 ($) : locked :locked { 1; }
 179 sub test_a2 : locked { 1; }
 180 # And that was all it has. You were expected to manually inspect the output
 181 ## Get
 182 Warning: AutoSplit had to create top-level *DIR* unexpectedly.
 183 AutoSplitting *INC*/*MOD*.pm (*DIR*/*MOD*)
 184 *INC*/*MOD*.pm: some names are not unique when truncated to 8 characters:
 185  directory *DIR*/*MOD*:
 186   testtesttesttest4_1.al, testtesttesttest4_2.al truncate to testtest
 187  directory *DIR*/Yet/Another/AutoSplit:
 188   testtesttesttest4_1.al, testtesttesttest4_2.al truncate to testtest
 189 ## Files
 190 *DIR*/*MOD*/autosplit.ix
 191 *DIR*/*MOD*/test1.al
 192 *DIR*/*MOD*/test2.al
 193 *DIR*/*MOD*/test3.al
 194 *DIR*/*MOD*/testtesttesttest4_1.al
 195 *DIR*/*MOD*/testtesttesttest4_2.al
 196 *DIR*/Just/Another/test5.al
 197 *DIR*/*MOD*/test6.al
 198 *DIR*/Yet/Another/AutoSplit/testtesttesttest4_1.al
 199 *DIR*/Yet/Another/AutoSplit/testtesttesttest4_2.al
 200 *DIR*/Yet/More/Attributes/test_a1.al
 201 *DIR*/Yet/More/Attributes/test_a2.al
 202 ## Require
 203 *MOD*/autosplit.ix
 204 ## Match
 205 # Need to find these lines somewhere in the required file
 206 sub test1\s*\(\$\);
 207 sub test2\s*\(\$\$\);
 208 sub test3\s*\(\$\$\$\);
 209 sub testtesttesttest4_1\s*\(\$\);
 210 sub testtesttesttest4_2\s*\(\$\$\);
 211 sub test_a1\s*\(\$\)\s*:\s*locked\s*:\s*locked\s*;
 212 sub test_a2\s*:\s*locked\s*;
 213 ## Tests
 214 is (*MOD*::test1 (1), 'test 1');
 215 is (*MOD*::test2 (1,2), 'test 2');
 216 is (*MOD*::test3 (1,2,3), 'test 3');
 217 ok (!defined eval "*MOD*::test1 () eq 'test 1'" and $@ =~ /^Not enough arguments for *MOD*::test1/, "Check prototypes mismatch fails") or print "# \$\@='$@'";
 218 is (&*MOD*::testtesttesttest4_1, "test 4");
 219 is (&*MOD*::testtesttesttest4_2, "duplicate test 4");
 220 is (&Just::Another::test5, "another test 5");
 221 # very messy way to interpolate function into regexp, but it's going to be
 222 # needed to get : for Mac filespecs
 223 like (&*MOD*::test6, qr!^*INC*/*MOD*.pm \(autosplit into @{[File::Spec->catfile('*DIR*','*MOD*', 'test6.al')]}\):\d+$!);
 224 ok (Yet::Another::AutoSplit->testtesttesttest4_1 eq "another test 4");
 225 ################################################################
 226 ## Name
 227 missing use AutoLoader;
 228 ## File
 229 1;
 230 __END__
 231 ## Get
 232 ## Files
 233 # There should be no files.
 234 ################################################################
 235 ## Name
 236 missing use AutoLoader; (but don't skip)
 237 ## Extra
 238 0, 0
 239 ## File
 240 1;
 241 __END__
 242 ## Get
 243 AutoSplitting *INC*/*MOD*.pm (*DIR*/*MOD*)
 244 ## Require
 245 *MOD*/autosplit.ix
 246 ## Files
 247 *DIR*/*MOD*/autosplit.ix
 248 ################################################################
 249 ## Name
 250 Split prior to checking whether obsolete files get deleted
 251 ## File
 252 use AutoLoader 'AUTOLOAD';
 253 1;
 254 __END__
 255 sub obsolete {my $a if 0; return $a++;}
 256 sub gonner {warn "This gonner function should never get called"}
 257 ## Get
 258 AutoSplitting *INC*/*MOD*.pm (*DIR*/*MOD*)
 259 ## Require
 260 *MOD*/autosplit.ix
 261 ## Files
 262 *DIR*/*MOD*/autosplit.ix
 263 *DIR*/*MOD*/gonner.al
 264 *DIR*/*MOD*/obsolete.al
 265 ## Tests
 266 is (&*MOD*::obsolete, 0);
 267 is (&*MOD*::obsolete, 1);
 268 {my $time = time; print "# time is $time\n"; sleep (2); sleep (2) unless time > $time + 1}
 269 printf "# time is %d (hopefully >=2 seconds later)\n", time;
 270 ## SameAgain
 271 True, so don't scrub this directory.
 272 Need the sleep hack else the next test is so fast that the timestamp compare
 273 routine in AutoSplit thinks that it shouldn't split the files.
 274 IIRC DOS FAT filesystems have only 2 second granularity.
 275 ################################################################
 276 ## Name
 277 Check whether obsolete files get deleted
 278 ## File
 279 use AutoLoader 'AUTOLOAD';
 280 1;
 281 __END__
 282 sub skeleton {"bones"};
 283 sub ghost {"scream"}; # This definition gets overwritten with the one below
 284 sub ghoul {"wail"};
 285 sub zombie {"You didn't use fire."};
 286 sub flying_pig {"Oink oink flap flap"};
 287 ## Get
 288 AutoSplitting *INC*/*MOD*.pm (*DIR*/*MOD*)
 289 ## Require
 290 *MOD*/autosplit.ix
 291 ## Files
 292 *DIR*/*MOD*/autosplit.ix
 293 *DIR*/*MOD*/skeleton.al
 294 *DIR*/*MOD*/zombie.al
 295 *DIR*/*MOD*/ghost.al
 296 *DIR*/*MOD*/ghoul.al
 297 *DIR*/*MOD*/flying_pig.al
 298 ## Tests
 299 is (&*MOD*::skeleton, "bones", "skeleton");
 300 eval {&*MOD*::gonner}; ok ($@ =~ m!^Can't locate auto/*MOD*/gonner.al in \@INC!, "Check &*MOD*::gonner is now a gonner") or print "# \$\@='$@'\n";
 301 {my $time = time; print "# time is $time\n"; sleep (2); sleep (2) unless time > $time + 1}
 302 printf "# time is %d (hopefully >=2 seconds later)\n", time;
 303 ## SameAgain
 304 True, so don't scrub this directory.
 305 ################################################################
 306 ## Name
 307 Check whether obsolete files remain when keep is 1
 308 ## Extra
 309 1, 1
 310 ## File
 311 use AutoLoader 'AUTOLOAD';
 312 1;
 313 __END__
 314 sub ghost {"bump"};
 315 sub wraith {9};
 316 ## Get
 317 AutoSplitting *INC*/*MOD*.pm (*DIR*/*MOD*)
 318 ## Require
 319 *MOD*/autosplit.ix
 320 ## Files
 321 *DIR*/*MOD*/autosplit.ix
 322 *DIR*/*MOD*/skeleton.al
 323 *DIR*/*MOD*/zombie.al
 324 *DIR*/*MOD*/ghost.al
 325 *DIR*/*MOD*/ghoul.al
 326 *DIR*/*MOD*/wraith.al
 327 *DIR*/*MOD*/flying_pig.al
 328 ## Tests
 329 is (&*MOD*::ghost, "bump");
 330 is (&*MOD*::zombie, "You didn't use fire.", "Are our zombies undead?");
 331 {my $time = time; print "# time is $time\n"; sleep (2); sleep (2) unless time > $time + 1}
 332 printf "# time is %d (hopefully >=2 seconds later)\n", time;
 333 ## SameAgain
 334 True, so don't scrub this directory.
 335 ################################################################
 336 ## Name
 337 Without the the timestamp check make sure that nothing happens
 338 ## Extra
 339 0, 1, 1
 340 ## Require
 341 *MOD*/autosplit.ix
 342 ## Files
 343 *DIR*/*MOD*/autosplit.ix
 344 *DIR*/*MOD*/skeleton.al
 345 *DIR*/*MOD*/zombie.al
 346 *DIR*/*MOD*/ghost.al
 347 *DIR*/*MOD*/ghoul.al
 348 *DIR*/*MOD*/wraith.al
 349 *DIR*/*MOD*/flying_pig.al
 350 ## Tests
 351 is (&*MOD*::ghoul, "wail", "still haunted");
 352 is (&*MOD*::zombie, "You didn't use fire.", "Are our zombies still undead?");
 353 {my $time = time; print "# time is $time\n"; sleep (2); sleep (2) unless time > $time + 1}
 354 printf "# time is %d (hopefully >=2 seconds later)\n", time;
 355 ## SameAgain
 356 True, so don't scrub this directory.
 357 ################################################################
 358 ## Name
 359 With the the timestamp check make sure that things happen (stuff gets deleted)
 360 ## Extra
 361 0, 1, 0
 362 ## Get
 363 AutoSplitting *INC*/*MOD*.pm (*DIR*/*MOD*)
 364 ## Require
 365 *MOD*/autosplit.ix
 366 ## Files
 367 *DIR*/*MOD*/autosplit.ix
 368 *DIR*/*MOD*/ghost.al
 369 *DIR*/*MOD*/wraith.al
 370 ## Tests
 371 is (&*MOD*::wraith, 9);
 372 eval {&*MOD*::flying_pig}; ok ($@ =~ m!^Can't locate auto/*MOD*/flying_pig.al in \@INC!, "There are no flying pigs") or print "# \$\@='$@'\n";