| 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"; |