#!/usr/bin/perl
#
#  Copyright (C) 1999-2002 Glen Colbert, Bernard Giroud, David Essex
#  
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2, or (at your option)
#  any later version.
#  
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#  
#  You should have received a copy of the GNU General Public License
#  along with this software; see the file COPYING.  If not, write to
#  the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
#  Boston, MA 02111-1307 USA
#
#----------------------------------------------------------------------------------- 
# Name        : test_cobol.pl
# Description : This script drives the TinyCOBOL regression test/validation process.
# Author      : Glen Colbert - gcolbert@uswest.net
# Modified    : Bernard Giroud, David Essex, Stephen Connolly
#----------------------------------------------------------------------------------- 

$VERSION="v010712";
$PWD = `dirname \$PWD`;
chop($PWD);

# ######################################################
# # This script performs compiles on the code that is  #
# # being tested, so parts of it look a little like a  #
# # make file.  This section defines command line flags#
# # for the compiles.                                  #
# ######################################################
$g_libraries1="-L/usr/local/lib";
$g_includes="-I/usr/include";
$g_libraries="-L/usr/lib -L/opt/cobol/lib";

# ######################################################
# # The names for the executables to perform compiler  #
# # functions follow.  Note that cob should be htcobol. 
# ######################################################
$CCX=gcc;
$LD=gcc;
$ASM=as;
$COB= "$PWD" . "/compiler/htcobol";
#$COBPP="$PWD" . "/cobpp/htcobolpp";

# ######################################################
# # Set the TCOB_OPTIONS_PATH environment variable.    #
# # This is used by htcobol to set compiler defaults.  # 
# # Set the TCOB_RTCONFIG_PATH environment variable.   #
# # This is used by the RTL to set run-time defaults.  # 
# ######################################################
#$ENV{"TCOB_PP_PATH"} = "$PWD" . "/cobpp";
$ENV{"TCOB_OPTIONS_PATH"} = "$PWD" . "/compiler";
$ENV{"TCOB_RTCONFIG_PATH"} = "$PWD" . "/lib";

$INCLUDES="-I./ " . $g_includes;
$CCXFLAGS=$INCLUDES . " -g";
# 
# ###########################################################
# # Get library DB name from the resource (htcobolrc) file. #
# # LD_IO_LIBS: -ldb                                        #
# ###########################################################
$LIBDBNAME="-ldb";
$TEMP_FILE_NAME="temp.$$.txt";
$RC_FILE_NAME="../compiler/htcobolrc";
system("grep '^LD_IO_LIBS' $RC_FILE_NAME | cut -f2 -d':' >$TEMP_FILE_NAME");
open(TEMP_FILE, $TEMP_FILE_NAME) || 
     die "Unable to open temp file";
while ($TEST_LINE = <TEMP_FILE>)
{
  chop($TEST_LINE);
  $LIBDBNAME=$TEST_LINE;
} 
unlink($TEMP_FILE_NAME);
# 
# $LIBDBNAME="db";
# if (-r "/usr/lib/libdb2.a")	# i.e. RedHat 7.0 version
#    {
#    $LIBDBNAME="db2";
#    }
#$LIBS=$g_libraries  . " -L../../lib  -lreadline -lncurses -ldl -lhtcobol -l" . $LIBDBNAME . " -lm -lreadline";
# 
#$LIBS=$g_libraries  . " -L../../lib  -lreadline -lncurses -ldl -lhtcobol -lhtcobol2 " . $LIBDBNAME . " -lm -lreadline";
#$LIBS=$g_libraries  . " -L../../lib  -lhtcobol " . $LIBDBNAME ;
#$LIBS=$g_libraries  . " -L../../lib  -lhtcobol " . $LIBDBNAME ;
$LIBS=$g_libraries  . " -L../../lib  -lhtcobol " . $LIBDBNAME . " -ldl" . " -lm";
$LDFLAGS=" -g ";
$COBFLAGS="";
$ASMFLAGS="";

# ######################################################
# # DECLARATIONS                                       #
# ######################################################

# ######################################################
# # SUBROUTINES START HERE                             #
# ######################################################
sub make_executable
{
$COBOL_CLASSIC="NO";
# ######################################################
# # Test for existence of file.  If .cbl, use cobpp.   #
# ######################################################
if (-r "$SOURCE.cbl")
   {
#   system("$COBPP -x $SOURCE.cbl > $SOURCE.cob");
   system("$COB -X -E $SOURCE.cbl -o $SOURCE.cob");
   $COBOL_CLASSIC="YES";
   wait;
   }
else
   {
   if (-r "$SOURCE.cob")
      {
      }
   else
      {
      printf (stderr "Cobol source code not found for $SOURCE test\n");
      return 1;
      }
   }
# ######################################################
# # Compile cobol source to an assembler source file   #
# ######################################################
printf(stdout "Compiling program $SOURCE ... ");
$rc=system("$COB -P -S $SOURCE.cob >$SOURCE.scan 2>&1");
$rc = ($rc >> 8);
printf(stdout "Compile return code = %d\n",$rc);
if ($rc >= 16)
   {
   printf( stderr "Program %s failed to properly compile\n",$SOURCE);
   return 2;
   }
# Note: the gstabs option is only valid in later version of GAS thus has been removed
#$rc=system("$ASM  -o $SOURCE.o -as=$SOURCE.listing.0.txt --gstabs $SOURCE.s");
#$rc=system("$ASM  -o $SOURCE.o -as=$SOURCE.listing.0.txt $SOURCE.s");
$rc=system("$ASM -D -o $SOURCE.o -as=$SOURCE.listing.0.txt $SOURCE.s");

if ($rc != 0)
   {
   printf( stderr "Program %s failed in assembler generation\n",$SOURCE);
   return 3;
   }
$rc=system("grep -v 'LISTING' $SOURCE.listing.0.txt | sed '/^$$/d' >$SOURCE.txt ");

$rc=system("$LD $LDFLAGS -o $SOURCE $SOURCE.o  $LIBS");

if ($rc != 0)
   {
   printf( stderr "Program %s failed to link edit\n",$SOURCE);
   return 4;
   }

if ($COBOL_CLASSIC eq "YES")
   {
   unlink("$SOURCE.cob");
   }
unlink("$SOURCE.o");
unlink("$SOURCE.s");
unlink("$SOURCE.scan");
unlink("$SOURCE.lis");
unlink("$SOURCE.txt");
#unlink("$SOURCE.listing.0.txt");
$rc=system("rm -f temp.*.$SOURCE.cob");

return 0;
}
# ######################################################
# # Make sure we have access to the tools.             #
# ######################################################
sub validate_setup
{
printf(stdout "\n\nChecking to see if your kit is complete\n");
$SETUP_OK="YES";
# ######################################################
# # Make sure we can compile a 'C' program.            #
# ######################################################

open (CPROG,">foo_c.c") || die "Unable to write to directory";
print CPROG "/* test program */\n";
print CPROG "main()\n";
print CPROG "{\n";
print CPROG "printf(\"Hi there\");\n";
print CPROG "}\n";
close (CPROG);

$rc=system("$CCX -c foo_c.c");
if ($rc != 0)
   {
   $SETUP_OK = "NO";
   printf(stderr "C compiler not executing properly\n");
   }

# ######################################################
# # Make sure we can assemble an output file           #
# ######################################################

open (APROG,">foo_s.s") || die "Unable to write to directory";
print APROG "testx.:\n";
print APROG ".text\n";
print APROG "    .align 16\n";
print APROG ".globl main\n";
print APROG "main:\n";
print APROG "     ret\n";
print APROG "\n";
close (APROG);

$rc=system("$ASM -D -o foo_s.o -aslh=foo_s.listing foo_s.s");
if ($rc != 0)
   {
   $SETUP_OK = "NO";
   printf(stderr "assembler not executing properly %d\n",$rc);
   }

# ######################################################
# # Make sure that we have cobpp for classic cobol     #
# ######################################################

open (CPROG,">basic.cbl") || die "Unable to write to directory";
print CPROG "000010 IDENTIFICATION DIVISION.                               \n";
print CPROG "000011 PROGRAM-ID. BASIC.                                     \n";
print CPROG "000012                                                        \n";
print CPROG "000013 ENVIRONMENT DIVISION.                                  \n";
print CPROG "000014 CONFIGURATION SECTION.                                 \n";
print CPROG "000015*INPUT-OUTPUT SECTION.                                  \n";
print CPROG "000016                                                        \n";
print CPROG "000017 DATA DIVISION.                                         \n";
print CPROG "000017 FILE SECTION.                                          \n";
print CPROG "000018 WORKING-STORAGE SECTION.                               \n";
print CPROG "000019 01   WS-COUNTERS.                                      \n";
print CPROG "000020      05 WS-COUNT-1       PIC X.                        \n";
print CPROG "000021                                                        \n";
print CPROG "000022 PROCEDURE DIVISION.                                    \n";
print CPROG "000023 0000-PROGRAM-ENTRY.                                    \n";
print CPROG "000024      STOP RUN.                                         \n";
close (CPROG);

#$rc=system("$COBPP -f basic.cbl > basic.cob");
$rc=system("$COB -F -E basic.cbl -o basic.cob");
if ($rc != 0)
   {
   $SETUP_OK = "NO";
   printf(stderr "Cobol preprocessor not executing properly %d\n",$rc);
   }

# ######################################################
# # Make sure that we have htcobol in path             #
# ######################################################
$rc=system("$COB -P -S basic.cob >/dev/null 2>&1");
if ($rc != 0)
   {
   $SETUP_OK = "NO";
   printf(stderr "Cobol compiler not executing properly %d\n",$rc);
   }

# ######################################################
if ($SETUP_OK ne "YES")
   {
   &setup_error;
   exit -1;
   }
$v_line = `grep 'version' basic.s`;
chop($v_line);
unlink("basic.cbl");
unlink("basic.cob");
unlink("basic.s");
unlink("basic.lis");
$rc=system("rm -f temp.*.basic.cob");
unlink("foo_s.o");
unlink("foo_s.s");
unlink("foo_s.listing");
unlink("foo_c.c");
unlink("foo_c.o");

printf(stdout "Your kit looks complete.\n+++++++++++++++++++++++++\n\n");
}
# ######################################################
sub setup_error
{
printf(stdout "The tools needed to perform these tests are not configured\n");
printf(stdout "in a way that the tests can be run.  Check to make sure\n");
printf(stdout "that the following variables are set up and usable:\n");

printf(stdout "\$CCX=gcc;");
printf(stdout "\$LD=gcc;");
printf(stdout "\$ASM=as;");
printf(stdout "\$COB=htcobol;");
#printf(stdout "\$COBPP=htcobolpp;");
}
# ######################################################
# # Make sure that we have htcobol in path             #
# ######################################################
sub just_compile
{
$COBOL_CLASSIC="NO";
# ######################################################
# # Test for existence of file.  If .cbl, use cobpp.   #
# ######################################################
if (-r "$SOURCE.cbl")
   {
#   system("$COBPP -f $SOURCE.cbl > $SOURCE.cob");
   system("$COB -F -E $SOURCE.cbl -o $SOURCE.cob");
   $COBOL_CLASSIC="YES";
   wait;
   }
else
   {
   if (-r "$SOURCE.cob")
      {
      }
   else
      {
      printf (stderr "Cobol source code not found for $SOURCE test\n");
      return 1;
      }
   }
# ######################################################
# # Compile cobol source to an assembler source file   #
# ######################################################
printf(stdout "Compiling program $SOURCE ... ");
$rc=system("$COB -P -S $SOURCE >$SOURCE.scan 2>&1");
$rc = ($rc >> 8);
printf(stdout "Compile return code = %d\n",$rc);
if ($rc != 0)
   {
   printf( stderr "Program %s failed to properly compile\n",$SOURCE);
   }

if (@progvak[1] eq "A")
   {
   if ($rc != 0)
      {
      printf(stderr "Program %s/%s could not compile!!\n",$SOURCE_DIR,$SOURCE);
      printf(stderr "If this test fails, all other tests are invalid\n");
      printf(stderr "Aborting the test run.\n");
      exit -1;
      }
   }

if (@progvak[1] eq "T" || @progvak[1] eq "A" )
   {
   if ($rc == 0)
      {
      $TEST_STATUS{@progvak[2]} = "PASS";
      }
   else
      {
      $TEST_STATUS{@progvak[2]} = "FAIL";
      $GROUP_SUCCESS = "FAILED";
      }
   }
if (@progvak[1] eq "F")
   {
   if ($rc == 0)
      {
      $TEST_STATUS{@progvak[2]} = "FAIL";
      $GROUP_SUCCESS = "FAILED";
      }
   else
      {
      $TEST_STATUS{@progvak[2]} = "PASS";
      }
   }
if (@progvak[1] eq "W")
   {
   if ($rc <= 4)
      {
      $TEST_STATUS{@progvak[2]} = "PASS";
      }
   else
      {
      $TEST_STATUS{@progvak[2]} = "FAIL";
      $GROUP_SUCCESS = "FAILED";
      }
   }
if ($COBOL_CLASSIC eq "YES")
   {
   unlink("$SOURCE.cob");
   }
unlink("$SOURCE.lis");
if ($SOURCE_DIR ne "call_tests")
   {
   unlink("$SOURCE.s");
   }
unlink("$SOURCE.scan");
}
# #############################################
sub get_results
{
$TEST_COUNTER = 0;
while ($INSTR = <TEST>)
   {
   @progvar = split(/:/,$INSTR);
   chop(@progvar[3]);
   $len = length(@progvar[3]);
   if ( $len > 0 )
      {
      $TEST_COUNTER = $TEST_COUNTER + 1;
      $CURRENT_TEST= @progvar[0];
      $TEST_NAME{@progvar[0]} = @progvar[0];
      $TEST_DESC{@progvar[0]} = @progvar[3] . " : Expecting " . @progvar[2] . " got " .@progvar[1];
      if (@progvar[1] eq @progvar[2])
         {
         $TEST_STATUS{@progvar[0]} = "PASS";
         &print_results;
         }
      else
         {
         $TEST_STATUS{@progvar[0]} = "FAIL";
         $GROUP_SUCCESS = "FAILED";
         &print_results;
         }
      }
   }
if ($TEST_COUNTER == 0)
   {
   $GROUP_SUCCESS = "FAILED";
   }
}
# #############################################
sub print_results
{
printf (TEST_LOG "%5s: %5s %s\n",$CURRENT_TEST,$TEST_STATUS{$CURRENT_TEST},$TEST_DESC{$CURRENT_TEST});
}

sub std_test()
{
# ######################################################
# #                                                    #
# ######################################################
chdir($SOURCE_DIR);
open (TEST_LIST,"test.script");
while ($TEST_LINE = <TEST_LIST>)
   {
   @progvak = split(/:/,$TEST_LINE);
   chop(@progvak[2]);
   if (substr(@progvak[0],0,1) ne "#")
      {
      $GROUP_SUCCESS = "PASSED";
      $SOURCE = @progvak[0];
      unlink("$SOURCE");
      $TEST_TYPE= @progvak[1];
      $TEST_TEXT = @progvak[2];
      $TEST_REQUIREMENT = @progvak[3];
      &make_executable;
      printf(TEST_LOG "########################################################################\n");
      printf(TEST_LOG "# %-67s  #\n",$TEST_TEXT);
      printf(TEST_LOG "# Test Directory: %-25s Test File %-15s  #\n",$SOURCE_DIR,$SOURCE);
      printf(TEST_LOG "########################################################################\n\n");
      if (-e $SOURCE)
         {
         $rc=system("./$SOURCE >> $SOURCE.txt");
         $rc = ($rc >> 8);
         if ($rc != 0)
            {
            printf(stdout "Program run return code = %d\n",$rc);
            printf( stderr "Program %s returned an unexpected return code\n",$SOURCE);
            printf( TEST_LOG "Program %s returned an unexpected return code\n",$SOURCE);
            }
         if ($TEST_TYPE eq "S")
            {
            open(TEST,"<$SOURCE.txt");
            &get_results;
            close(TEST);
            printf(TEST_LOG "  %-67s: %s\n\n",$TEST_TEXT,$GROUP_SUCCESS);
            unlink("$SOURCE");
            unlink("$SOURCE.lis");
            unlink("$SOURCE.txt");
            wait;
            }
         else
            {
            printf(stderr "Unknown test validation %s - %s tests\n",$SOURCE,$TEST_TEXT);
            printf(TEST_LOG "Unknown test validation %s - %s tests\n",$SOURCE,$TEST_TEXT);
            }
         }
      else
         {
         printf(stderr "Could not generate %s - %s tests\n",$SOURCE,$TEST_TEXT);
         printf(TEST_LOG "Could not generate %s - %s tests\n",$SOURCE,$TEST_TEXT);
         }
      }
   }
close(TEST_LIST);

chdir("..");
}

# ######################################################
# # MAIN LOGIC                                         #
# ######################################################
$LOG_FILE_NAME="test$$.log";
open(TEST_LOG,">$LOG_FILE_NAME") || die "Unable to write log file";

printf(stdout "\nCobol test suite version %s\n",$VERSION);
printf(TEST_LOG "Cobol test suite version %s\n\n",$VERSION);

&validate_setup;

printf(TEST_LOG "#######################################################\n");
printf(TEST_LOG "# Cobol regression test suite                         #\n");
printf(TEST_LOG "# Testing compiler:                                   #\n");
printf(TEST_LOG "# %s  #\n",$v_line);
printf(TEST_LOG "#######################################################\n");
printf("#######################################################\n");
printf("# Testing compiler:                                   #\n");
printf("# %s  #\n",$v_line);
printf("#######################################################\n");

# ######################################################
# # Tests are performed in line                        #
# ######################################################

# ######################################################
# # Compile only tests.  results are not executed.     #
# ######################################################
printf(TEST_LOG "########################################################################\n");
printf(TEST_LOG "# COMPILER ONLY TESTS - DIRECTORY compile_tests.                       #\n");
printf(TEST_LOG "########################################################################\n");

$GROUP_SUCCESS = "PASSED";

$SOURCE_DIR="compile_tests";
chdir($SOURCE_DIR);
open (TEST_LIST,"test.script");
while ($TEST_LINE = <TEST_LIST>)
   {
   @progvak = split(/:/,$TEST_LINE);
   if (substr(@progvak[0],0,1) ne "#")
      {
      $TEST_NAME{@progvak[2]} = @progvak[2];
      chop(@progvak[3]);
      $CURRENT_TEST= @progvak[2];
      $TEST_DESC{@progvak[2]} = @progvak[3];
      $SOURCE=@progvak[0];
      &just_compile;
      &print_results;
      }
   }
close(TEST_LIST);
printf(TEST_LOG "\n    COMPILER ONLY TESTS: %s\n\n",$GROUP_SUCCESS);
$rc=system("rm -f temp.*.*.cob");
chdir("..");

$SOURCE_DIR="format_tests";
&std_test;

$SOURCE_DIR="seqio_tests";
&std_test;
system("rm -f *.dat");

$SOURCE_DIR="idxio_tests";
&std_test;

$SOURCE_DIR="sortio_tests";
&std_test;

$SOURCE_DIR="perform_tests";
&std_test;

$SOURCE_DIR="condition_tests";
&std_test;

$SOURCE_DIR="search_tests";
&std_test;

# ######################################################
# # Calling tests                                      #
# ######################################################
$SOURCE_DIR="call_tests";
#$LIBS=$LIBS  . " -L. -lcalls -lreadline -lncurses -lhtcobol -l" . $LIBDBNAME . " -lm -lreadline";
$LIBS=$LIBS  . " -L. -lcalls -lreadline -lncurses -lhtcobol " . $LIBDBNAME . " -lm -lreadline";
chdir($SOURCE_DIR);
system("ls -1 st*.c st*.cob >t_sub.idx");

open (TEST_LIST,"t_sub.idx");
while ($TEST_LINE = <TEST_LIST>)
   {
   chop($TEST_LINE);
   @subname = split(/\./,$TEST_LINE,2);
   if (@subname[1] eq "cob")
      {
      $SOURCE=@subname[0];
      &just_compile;
      $cmd="$ASM -o " . $SOURCE . ".o " . $SOURCE . ".s";
      $rc=system($cmd);
      }
   else
      {
      printf ("Compiling subroutine %s\n", @subname[0]);
      $cmd="$CCX -c " . $TEST_LINE;
      $rc=system($cmd);
      }
   }
close(TEST_LIST);
unlink("t_sub.idx");
# Collect all subroutines into one library
$rc=system("ar cr libcalls.a st*.o");
$rc=system("rm -f st*.o st*.s");
$rc=system("rm -f temp.*.*.cob");
chdir("..");
&std_test;
# Remove the library
$libfn=$SOURCE_DIR ."/libcalls.a";
unlink($libfn);

# ######################################################
# # Print test results.                                #
# ######################################################
printf ("\n\n");
foreach $test (keys(%TEST_NAME))
   {
   if ($TEST_STATUS{$test} eq "FAIL")
      {
      printf ("Test %6s: %6s %s\n",$test,$TEST_STATUS{$test},$TEST_DESC{$test});
      }
   }
printf ("\n\n");

close (TEST_LOG);
printf ("\n\nTest results are in %s\n\n",$LOG_FILE_NAME);
printf ("Changes from baseline results:\n");
$rc=system("diff test.baseline $LOG_FILE_NAME | grep -a '^>'");
printf ("\n\nTest results are in %s\n\n",$LOG_FILE_NAME);
printf ("\n");
exit 0;