#!/usr/bin/perl -w

use Cwd;

# Controlling script for comprehensive PMW tests. Run from within the "testing"
# directory. Optional arguments are:
#
#   valgrind    run tests under valgrind
#   autoquit    force quit after test failure instead of interacting
#   forceupdate force update after test failure instead of interacting
#   view        display before running each test
#   nob2pf      skip B2PF tests (auto skipped if not supported)
#   nomidi      skip MIDI tests (auto skipped if midiscv not present)
#   nopdf       do only PostScript tests
#
# Further arguments match a test directory optionally followed by a test name.
# If not given, looks for directories whose names end in "tests".

$cf = "diff -u";
$less = "less -EF";
$valgrind = "";
$pmw = "../src/pmw";
$dopdf = 1;
$force_update = 0;
$force_quit = 0;
$show_progress = 0;
$starttest = undef;
$endtest = undef;
$started = 0;
$view = 0;

# Skip certain directories for non-built features or non-available fonts

undef @skipdirs;

if (system("$pmw -C b2pf >/dev/null") == 0)
  {
  push @skipdirs, "B2PF";
  push @skipdirs, "afont";
  }
elsif (! -r "../fontextra/AdobeArabic-Regular.afm" ||
       ! -r "../fontextra/DejaVuSans.afm" ||
       ! -r "../fontextra/Tempora-Bold.afm")
  {
  push @skipdirs, "afont";
  }

if (system("$pmw -C musicxml >/dev/null") == 0)
  {
  push @skipdirs, "xml";
  push @skipdirs, "xout";
  }

if (system("midicsv /dev/null /dev/null >/dev/null 2>&1") == 0x7f00)
  {
  push @skipdirs, "midi";
  }

# Handle arguments. If valgrind is selected with output not to terminal,
# arrange to output progress information to the terminal, because this can
# take a long time.

while (defined $ARGV[0])
  {
  if ($ARGV[0] eq "valgrind")
    {
    $valgrind = "valgrind -q";
    if (! -t STDOUT)
      {
      $show_progress = 1;
      open(PROGRESS, ">/dev/tty") || die "Failed to open /dev/tty: $!\n";
      }
    shift;
    }
  elsif ($ARGV[0] eq "autoquit")
    {
    $force_quit = 1;
    $less = "cat";
    shift;
    }
  elsif ($ARGV[0] eq "forceupdate")
    {
    $force_update = 1;
    $less = "cat";
    shift;
    }
  elsif ($ARGV[0] eq "view")
    {
    $view = 1;
    shift;
    }
  elsif ($ARGV[0] =~ /^nob2pf$/i)
    {
    push @skipdirs, "B2PF";
    shift;
    }
  elsif ($ARGV[0] =~ /^nomidi$/i)
    {
    push @skipdirs, "midi";
    shift;
    }
  elsif ($ARGV[0] =~ /^nopdf$/i)
    {
    $dopdf = 0;
    shift;
    }
  else
    {
    last;
    }
  }

# Choose which directories' tests to run. Arguments can select a specific
# directory and test(s). Otherwise, look for directories whose names match a
# pattern.

undef @dirs;

if (defined $ARGV[0])
  {
  opendir DIR, ".";
  while ($d = readdir(DIR))
    {
    if ($d =~ /$ARGV[0]/ && $d =~ /^(.*)tests$/)
      {
      push @dirs, ($d, "out$1");
      last;
      }
    }

  die "Unknown test directory selector \"$ARGV[0]\"\n" if scalar @dirs <= 0;

  if (defined $ARGV[1])
    {
    $starttest = $endtest = $ARGV[1];
    $endtest = $ARGV[2] if defined $ARGV[2];
    $endtest = undef if $endtest eq "+";
    }
  }

# Scan for directories whose names end in "tests".

else
  {
  undef @dlist;
  opendir DIR, ".";
  while ($d = readdir(DIR)) { push @dlist, $d; }
  closedir DIR;
  @dlist = sort(@dlist);
  while ($d = shift(@dlist))
    {
    $OK = 1;
    foreach $sk (@skipdirs)
      {
      if ($d =~ /^$sk/) { $OK = 0; last; }
      }
    push @dirs, ($d, "out$1") if ($OK && $d =~ /^(.*)tests$/);
    }
  }

# Do the business

while (scalar @dirs > 0)
  {
  my($tests) = shift @dirs;
  my($outs) = shift @dirs;
  my($filecount) = 0;
  my($setspecialopt) = "";

  $setspecialopt = "-midi test.mid" if $tests =~ /^miditests$/;
  $setspecialopt = "-xml test.xml" if $tests =~ /^xouttests$/;

  if ($show_progress)
    {
    printf PROGRESS "Running $tests";
    }

  printf "*** Running $tests ****\n";

  opendir(DIR, $tests) || die "Failed to opendir $tests: $!\n";
  @files = sort(readdir(DIR));
  closedir(DIR);

  while (scalar @files > 0)
    {
    my($copy) = 0;
    my($file) = shift @files;
    my($options) = "";
    my($testOK) = 1;
    my($fontsearch) = "-F ../fontmetrics:../fontextra:../psfonts";
    
    # $specialopt is reset for some tests, so it must be reset for each file.
    
    my($specialopt) = $setspecialopt;

    # Skip . and .. and any file ending in .opt because that contains options
    # for any given test, and any that end in .inc because they are included
    # files, and any ending in .F because they specify fontmetrics directories
    # for some tests. A file ending in .nopdf is a way of skipping some tests
    # that are very PostScript-specific. A file ending in .pdfinc is a way of
    # suppressing the omission of font programs in PDF testing (for the testing
    # of font inclusion).

    next if $file =~ /^\.\.?$|\.opt$|\.inc$|\.F$|\.nopdf$|\.pdfinc$/;

    # Also skip any directories.

    next if -d "$tests/$file";

    next if !$started && defined $starttest && $file !~ /^\Q$starttest\E/;
    $started = 1;
    $filecount++;

    if ($show_progress && $filecount % 10 == 0)
      {
      printf PROGRESS ".";
      }

    # Note "chomp"s below; needed to get rid of the newline which otherwise
    # messes up the command.

    $fontsearch .= `cat $tests/$file.F` if -e "$tests/$file.F";
    chomp $fontsearch;

    $options = `cat $tests/$file.opt` if -e "$tests/$file.opt";
    chomp $options;

    # For testing MusicXML multi-movement output, a variation on the -xml
    # option is needed and is set in $options. In the event, we must unset
    # $specialopt.
     

    $specialopt = "" if $options =~ /-xml /;

    # Start clean

    unlink "test.out";
    unlink "test.txt";
    unlink "test.mid";
    unlink "test.xml";
    unlink "test-1.xml";
    unlink "test-2.xml";
    unlink "test-3.xml";

    # If "view" has been requested, run pmw without -testing and display any
    # PostScript output that it produces, before going on to do the actual
    # test.

    if ($view)
      {
      system("$pmw -norc -ps $options $fontsearch -o test-full.ps $tests/$file" .
                " -H  ../PSheader" .
                " -MF ../psfonts" .
                " -MP ../MIDIperc" .
                " -MV ../MIDIvoices" .
                " -SM ../macros" .
                " 2> /dev/null");

      # Need to get the absolute font path to pass to gv.

      getcwd() =~ /^(.*)\/testing$/;
      system ("GS_FONTPATH=$1/psfonts:$1/fontextra:\$GS_FONTPATH gv -scale=1 -geometry 1080x980+0+0 test-full.ps");

      for (;;)
        {
        print "Continue, Quit? [Q] ";
        open(T, "/dev/tty") || die "Failed to open /dev/tty: $!\n";
        $_ = <T>;
        close(T);
        exit 1 if /^q?$/i;
        last if /^c$/i;
        }
      }

    # Each test is run twice, for PostScript and PDF output, by default.
    # There's an option not to do the PDF test.

    $pdf = "-ps";
    $which = "PS";
    $header = "-H ../PSheader";
    $outext = "";

    for (;;)
      {
      my($testing) = 7;

      # On the PDF pass, check for PostScript-specific tests that are not
      # relevant to PDF.

      if ($pdf eq "-pdf" && -e "$tests/$file.nopdf")
        {
        printf("Test $file skipped PDF\n");
        last;
        }

      # Running pmw with -testing generates output that can be compared easily.
      # In the case of PostScript output, any non-zero value of "testing" cuts
      # out version and date information, and also avoids including the header
      # each time. In the case of PDF output, there are individual control bits
      # in the "testing" value:
      #
      #    0x01  Suppress version and date info
      #    0x02  Insert bar and page idents
      #    0x04  Omit actual programs
      #    0x08  Make output red
      #
      # Most PDF tests need a value of 7, but there is at least one test of
      # actual insertion of fonts.

      $testing = 3 if ($pdf eq "-pdf" && -e "$tests/$file.pdfinc");

      my($rc) = system("$valgrind $pmw -norc $pdf $header -testing $testing $options $specialopt $fontsearch -o test.out $tests/$file" .
                        " -MF ../psfonts" .
                        " -MP ../MIDIperc" .
                        " -MV ../MIDIvoices" .
                        " -SM ../macros" .
                        " 2> test.txt");

      # Compare stderr output

      if (! -z "test.txt")
        {
        if (! -e "$outs/$file.txt")
          {
          printf("There is text output, but $outs/$file.txt does not exist.\n");
          system("$less test.txt");
          exit 1;
          }

        $rc = system("$cf $outs/$file.txt test.txt >test.cf");

        if ($rc != 0)
          {
          # printf("text cf RC=$rc\n");
          system("$less test.cf");

          $testOK = 0;
          for (;;)
            {
            print "Continue, Update & retry, Quit? [Q] ";

            if ($force_quit)
              {
              $_ = 'q';
              print "... quit forced\n";
              }
            elsif ($force_update)
              {
              $_ = "u";
              print "... update forced\n";
              }
            else
              {
              open(T, "/dev/tty") || die "Failed to open /dev/tty: $!\n";
              $_ = <T>;
              close(T);
              }

            exit 1 if /^q?$/i;
            last if /^c$/i;

            if (/^u$/)
              {
              exit 1 if system("cp test.txt $outs/$file.txt") != 0;
              unshift @files, $file;
              print (("#" x 79) . "\n");
              last;
              }
            }

          redo if /^u$/;   # Repeat the test
          }
        }

      # For some tests (notably error testing) there is no PostScript or PDF.

      if (-e "test.out" || -e "$outs/$file$outext" || -e "$outs/$file$outext.gz")
        {
        system ("gunzip $outs/$file$outext.gz") if (-e "$outs/$file$outext.gz");

        $rc = system("$cf $outs/$file$outext test.out >test.cf");
        if ($rc != 0)
          {
          # printf("cf RC=$rc\n");
          system("$less test.cf");

          $testOK = 0;
          for (;;)
            {
            print "View, Continue, Update & retry, Quit? [Q] ";

            if ($force_quit)
              {
              $_ = 'q';
              print "... quit forced\n";
              }
            elsif ($force_update)
              {
              $_ = "u";
              print "... update forced\n";
              }
            else
              {
              open(T, "/dev/tty") || die "Failed to open /dev/tty: $!\n";
              $_ = <T>;
              close(T);
              }

            exit 1 if /^\s*q?$/i;
            last if /^\s*c$/i;

            # To view the new output we have to reprocess without -testing.

            if (/^\s*v$/)
              {
              system("$pmw -norc $pdf $header $options $fontsearch -o test-full.out $tests/$file" .
                        " -MF ../psfonts" .
                        " -MP ../MIDIperc" .
                        " -MV ../MIDIvoices" .
                        " -SM ../macros" .
                        " 2> /dev/null");

              # Need to get the absolute font path to pass to gv.

              getcwd() =~ /^(.*)\/testing$/;
              system ("GS_FONTPATH=$1/psfonts:$1/fontextra:\$GS_FONTPATH gv -scale=1 -geometry 1080x980+0+0 test-full.out");
              # Stay in loop to reprompt
              }

            elsif (/^\s*u$/)
              {
              exit 1 if system("cp test.out $outs/$file$outext") != 0;
              unshift @files, $file;
              print (("#" x 79) . "\n");
              last;
              }
            }
          }
        }

      # If there's a MIDI file, compare it in text format

      if (-e "$outs/$file.mid" || -e "test.mid")
        {
        if (! -e "$outs/$file.mid")
          {
          printf("There is MIDI output, but $outs/$file.mid does not exist.\n");
          exit 1;
          }

        if (! -e "test.mid")
          {
          printf("There is no MIDI output, but $outs/$file.mid exists.\n");
          exit 1;
          }

        system("midicsv $outs/$file.mid test-old.csv");
        system("midicsv test.mid test.csv");

        $rc = system("$cf test-old.csv test.csv >test.cf");
        if ($rc != 0)
          {
          $testOK = 0;
          system("$less test.cf");

          for (;;)
            {
            print "Continue, Update & retry, Quit? [Q] ";

            if ($force_quit)
              {
              $_ = 'q';
              print "... quit forced\n";
              }
            elsif ($force_update)
              {
              $_ = "u";
              print "... update forced\n";
              }
            else
              {
              open(T, "/dev/tty") || die "Failed to open /dev/tty: $!\n";
              $_ = <T>;
              close(T);
              }

            exit 1 if /^\s*q?$/i;
            last if /^\s*c$/i;

            if (/^\s*u$/)
              {
              exit 1 if system("cp test.mid $outs/$file.mid") != 0;
              unshift @files, $file;
              print (("#" x 79) . "\n");
              last;
              }
            }
          }
        else { printf "Test $file OK MIDI\n"; }
        }

      # If there's an XML output file, compare it. If multiple XML files have
      # been generated for multiple movements, concatenate them for ease of
      # comparision (and also minimize hacking existing code).

      system("cat test-*.xml > test.xml") if -e "test-1.xml" ;

      if (-e "$outs/$file.xml" || -e "test.xml")
        {
        if (! -e "$outs/$file.xml")
          {
          printf("There is XML output, but $outs/$file.xml does not exist.\n");
          exit 1;
          }

        if (! -e "test.xml")
          {
          printf("There is no XML output, but $outs/$file.xml exists.\n");
          exit 1;
          }

        $rc = system("$cf $outs/$file.xml test.xml >test.cf");

        if ($rc != 0)
          {
          # printf("XML cf RC=$rc\n");
          system("$less test.cf");

          $testOK = 0;
          for (;;)
            {
            print "Continue, Update & retry, Quit? [Q] ";

            if ($force_quit)
              {
              $_ = 'q';
              print "... quit forced\n";
              }
            elsif ($force_update)
              {
              $_ = "u";
              print "... update forced\n";
              }
            else
              {
              open(T, "/dev/tty") || die "Failed to open /dev/tty: $!\n";
              $_ = <T>;
              close(T);
              }

            exit 1 if /^q?$/i;
            last if /^c$/i;

            if (/^u$/)
              {
              exit 1 if system("cp test.xml $outs/$file.xml") != 0;
              unshift @files, $file;
              print (("#" x 79) . "\n");
              last;
              }
            }

          redo if /^u$/;   # Repeat the test
          }
        else { printf "Test $file OK XML\n"; }
        }

      if ($testOK)
        {
        printf ("Test $file OK $which\n");
        # system("gzip $outs/$file") if (-e "$outs/$file");
        }

      # If just done PostScript, repeat for PDF unless running MIDI or XML
      # output tests.

      if ($pdf eq "-ps" && $dopdf && $tests !~ /^xouttests$/ && 
          $tests !~ /^miditests$/)
        {
        $pdf = "-pdf";
        $header = "";
        $which = "PDF";
        $outext = ".pdf";
        }
      else { last; }
      }   # Loop for PS and PDF testing

    last if defined $endtest && $file =~ /^\Q$endtest\E/;
    }     # Loop for tests within a directory

  if ($show_progress)
    {
    printf PROGRESS "\n";
    }
  }       # Loop for test directories

close(PROGRESS) if $show_progress;
system("/bin/rm -f test-* test.*");
die "No selected test found\n" if !$started;

# End
