home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / MacPerl 5.1.3 / Mac_Perl_513_src / perl5.002 / t / TEST < prev   
Encoding:
Text File  |  1996-10-19  |  2.4 KB  |  125 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] =~ /^(68K|PPC)$/) {
  19.     $suff = ".$ARGV[0]";
  20.     shift;
  21. }
  22.  
  23. if ($ARGV[0] eq '-v') {
  24.     $verbose = 1;
  25.     shift;
  26. }
  27.  
  28. die "Run me from the :t directory" if (-f ':t:TEST');
  29.  
  30. if ($operation eq "prepare") {
  31.     print "Set Exit 0\n";
  32.     
  33.     if ($ARGV[0] eq '') {
  34.         @ARGV = split(/[ \n]/,
  35.          `echo :base:≈.t :comp:≈.t :cmd:≈.t :io:≈.t; echo :op:≈.t :lib:≈.t`);
  36.     }
  37.     
  38.     $bad = 0;
  39.     $good = 0;
  40.     $total = @ARGV;
  41.     while ($test = shift) {
  42.         if ($test =~ /^$/) {
  43.         next;
  44.         }
  45.         $te = $test;
  46.         chop($te);
  47.         print "echo \'----- $te" . '.' x (20 - length($te)) . "\'\n";
  48.         open(script,"$test") || die "Can't run $test.\n";
  49.         $_ = <script>;
  50.         close(script);
  51.         if (/#!..perl(.*)/) {
  52.         $switch = $1;
  53.         } else {
  54.         $switch = '';
  55.         }
  56.         print "::Perl$suff $switch $test\n";
  57.     }
  58. } elsif ($operation eq "evaluate") { 
  59.     $_ = "";
  60.     
  61. tests:     while (1)    {
  62.         while (1) {
  63.             last if /^-----/;
  64.             last tests unless ($_ = <>);
  65.         } 
  66.  
  67.         $_ =~ /----- (.*)/;
  68.         
  69.         print $1;
  70.         $ok = 0;
  71.         $next = 0;
  72.         ++$total;
  73.         
  74.         while (<>) {
  75.         last if (/^-----/);
  76.         
  77.         if ($verbose) {
  78.             print "\t$_";
  79.         }
  80.         unless (/^#/) {
  81.             if (/^1\.\.([0-9]+)/) {
  82.             $max = $1;
  83.             $totmax += $max;
  84.             $files += 1;
  85.             $next = 1;
  86.             $ok = 1;
  87.             } else {
  88.             $next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
  89.             if (/^ok (.*)/ && $1 == $next) {
  90.                 $next = $next + 1;
  91.             } else {
  92.                 $ok = 0;
  93.             }
  94.             }
  95.         }
  96.         }
  97.         $next = $next - 1;
  98.         if ($ok && $next == $max) {
  99.         print "ok\n";
  100.         $good = $good + 1;
  101.         } else {
  102.         $next += 1;
  103.         print "FAILED on test $next\n";
  104.         $bad = $bad + 1;
  105.         $_ = $test;
  106.         }
  107.         last if eof;
  108.     }
  109.     
  110.     if ($bad == 0) {
  111.         if ($ok) {
  112.         print "All tests successful.\n";
  113.         } else {
  114.         die "FAILED--no tests were run for some reason.\n";
  115.         }
  116.     } else {
  117.         $pct = sprintf("%.2f", $good / $total * 100);
  118.         if ($bad == 1) {
  119.         warn "Failed 1 test, $pct% okay.\n";
  120.         } else {
  121.         warn "Failed $bad/$total tests, $pct% okay.\n";
  122.         }
  123.     }
  124. }
  125.