home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / MacPerl 5.0.3 / MacPerl Source ƒ / Perl5 / t / TEST < prev   
Encoding:
Text File  |  1995-10-31  |  2.3 KB  |  120 lines  |  [TEXT/MPS ]
  1. ::Perl -Sx "{0}" prepare {"Parameters"} > MacPerlTest.Run
  2. :MacPerlTest.Run ∑ MacPerlTest.Out
  3. ::Perl -Sx "{0}" evaluate {"Parameters"} MacPerlTest.Out
  4. Delete MacPerlTest.Out MacPerlTest.Run
  5. Exit 0
  6.  
  7. #!./perl
  8.     
  9. # $RCSfile: TEST,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:59:30 $
  10.  
  11. # This is written in a peculiar style, since we're trying to avoid
  12. # most of the constructs we'll be testing for.
  13.  
  14. $| = 1;
  15.  
  16. $operation = shift;
  17.  
  18. if ($ARGV[0] eq '-v') {
  19.     $verbose = 1;
  20.     shift;
  21. }
  22.  
  23. die "Run me from the :t directory" if (-f ':t:TEST');
  24.  
  25. if ($operation eq "prepare") {
  26.     print "Set Exit 0\n";
  27.     
  28.     if ($ARGV[0] eq '') {
  29.         @ARGV = split(/[ \n]/,
  30.          `echo :base:≈.t :comp:≈.t :cmd:≈.t :io:≈.t; echo :op:≈.t :lib:≈.t`);
  31.     }
  32.     
  33.     $bad = 0;
  34.     $good = 0;
  35.     $total = @ARGV;
  36.     while ($test = shift) {
  37.         if ($test =~ /^$/) {
  38.         next;
  39.         }
  40.         $te = $test;
  41.         chop($te);
  42.         print "echo \'----- $te" . '.' x (20 - length($te)) . "\'\n";
  43.         open(script,"$test") || die "Can't run $test.\n";
  44.         $_ = <script>;
  45.         close(script);
  46.         if (/#!..perl(.*)/) {
  47.         $switch = $1;
  48.         } else {
  49.         $switch = '';
  50.         }
  51.         print "::Perl$switch $test\n";
  52.     }
  53. } elsif ($operation eq "evaluate") { 
  54.     $_ = "";
  55.     
  56. tests:     while (1)    {
  57.         while (1) {
  58.             last if /^-----/;
  59.             last tests unless ($_ = <>);
  60.         } 
  61.  
  62.         $_ =~ /----- (.*)/;
  63.         
  64.         print $1;
  65.         $ok = 0;
  66.         $next = 0;
  67.         ++$total;
  68.         
  69.         while (<>) {
  70.         last if (/^-----/);
  71.         
  72.         if ($verbose) {
  73.             print "\t$_";
  74.         }
  75.         unless (/^#/) {
  76.             if (/^1\.\.([0-9]+)/) {
  77.             $max = $1;
  78.             $totmax += $max;
  79.             $files += 1;
  80.             $next = 1;
  81.             $ok = 1;
  82.             } else {
  83.             $next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
  84.             if (/^ok (.*)/ && $1 == $next) {
  85.                 $next = $next + 1;
  86.             } else {
  87.                 $ok = 0;
  88.             }
  89.             }
  90.         }
  91.         }
  92.         $next = $next - 1;
  93.         if ($ok && $next == $max) {
  94.         print "ok\n";
  95.         $good = $good + 1;
  96.         } else {
  97.         $next += 1;
  98.         print "FAILED on test $next\n";
  99.         $bad = $bad + 1;
  100.         $_ = $test;
  101.         }
  102.         last if eof;
  103.     }
  104.     
  105.     if ($bad == 0) {
  106.         if ($ok) {
  107.         print "All tests successful.\n";
  108.         } else {
  109.         die "FAILED--no tests were run for some reason.\n";
  110.         }
  111.     } else {
  112.         $pct = sprintf("%.2f", $good / $total * 100);
  113.         if ($bad == 1) {
  114.         warn "Failed 1 test, $pct% okay.\n";
  115.         } else {
  116.         warn "Failed $bad/$total tests, $pct% okay.\n";
  117.         }
  118.     }
  119. }
  120.