nilopaim
/
tinycobol
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
tinycobol/test_suite/cobol_test.pl

633 lines
20 KiB
Perl
Raw Permalink Blame History

#!/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;
Reference in New Issue View Git Blame Copy Permalink