"Fossies" - the Fresh Open Source Software Archive

Member "fort77-1.18/tests/test.pl" (6 Nov 1996, 2490 Bytes) of package /linux/misc/old/fort77-1.18.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 #! /usr/bin/perl
    2 # 
    3 # Regression test for the 'fort77' driver script.
    4 #
    5 
    6 #
    7 # List of tests to run and of expected files.
    8 # 
    9 
   10 $test = [
   11     [ "./fort77 -c foo.f",                 qw(foo.o) ],
   12     [ "./fort77 -c bar.F",                 qw(bar.o) ],
   13     [ "./fort77 -c -o gargle.o foo.f",     qw(gargle.o) ],
   14     [ "./fort77 foo.f",            qw(a.out) ],
   15     [ "./fort77 baz/bazfoo.f",         qw(a.out) ],
   16     [ "./fort77 -c baz/bazfoo.f",      qw(bazfoo.o) ],
   17     [ "./fort77 -o bar.o -c baz/bazfoo.f", qw(bar.o) ],
   18     [ "./fort77 -o tscht foo.f",       qw(tscht) ],
   19     [ "./fort77 -k foo.f",         qw(a.out foo.c) ],
   20     [ "./fort77 -g -k foo.f",          qw(foo.c a.out) ],
   21     [ "./fort77 -c -f long.f",         qw(long.o) ],
   22     [ "./fort77 mainmiss.f"             ],
   23     [ "./fort77 -c foo.f && ./fort77 -c mainmiss.f && ./fort77 -o foo foo.o mainmiss.o",
   24            qw(foo.o mainmiss.o foo) ],
   25     [ "./fort77 -c foo.f && ./fort77 -o foo foo.o mainmiss.f",
   26        qw(foo.o foo) ],
   27     [ "./fort77 synerr.f && touch gargle"       ]
   28 ];
   29 
   30 #
   31 # These files could possibly be generated by a buggy fort77
   32 # script; they are also checked.
   33 #
   34 
   35 @unexpected = qw(gargle.c baz/bazfoo.c baz/bazfoo.o mainmiss.o mainmiss.c
   36          synerr.o synerr.c baz/a.out bar.c);
   37 
   38 foreach $ref (@$test) {
   39     foreach $file(@$ref[1..@$ref-1]) {
   40     $files{$file} ++;
   41     }
   42 }
   43 
   44 foreach $file(@unexpected) {
   45     $files{$file} ++;
   46 }
   47 
   48 while ($_ = @ARGV[0]) {
   49     shift;
   50     if (/^-v/) {
   51     $verbose ++;
   52     }
   53 }
   54 
   55 foreach (keys %files) {
   56     unlink $_;
   57 }
   58 
   59 $errors = 0;
   60 foreach $ref (@$test) {
   61 
   62     $cmd = shift(@$ref);
   63     %expect = ();
   64     $cmd_error = 0;
   65 
   66     foreach $r (@$ref) {
   67     $expect{$r} ++;
   68     }
   69 
   70     print STDERR "$cmd ..." if $verbose > 0;
   71     $cmd = "( $cmd ) >/dev/null 2>&1" if $verbose <= 1;
   72 
   73     system($cmd);
   74 
   75     foreach (keys %files) {
   76     -f $_;
   77     if ($expect{$_}) {
   78         if (-f) {
   79         print STDERR " \"$_\" ok " if $verbose > 2;
   80         }
   81         else {
   82         print STDERR "\"$_\" not generated by \"$cmd\"\n";
   83         $errors ++;
   84         $error_seen ++;
   85         }
   86     }
   87     else {
   88         if (-f) {
   89         print STDERR " \"$_\" should not be generated by \"$cmd\"\n";
   90         $errors ++;
   91         $error_seen ++;
   92         }
   93         else {
   94         print STDERR " \"$_\" n-ok " if $verbose > 3;
   95         }
   96     }
   97     if (-f) {
   98         unlink $_ or die ("Could not unlink $_: $!\n");
   99         }
  100     }
  101     print STDERR " test successful.\n" if $verbose && ! $error_seen;
  102 }
  103 
  104 if ($errors == 0) {
  105     print STDERR "Passed all tests.\n" if $verbose;
  106     exit 0;
  107 }
  108 else {
  109     print STDERR "Total $errors error(s) encountered.\n";
  110     exit 1;
  111 }