version 0.73.0

This commit is contained in:
2023-07-14 12:15:30 -03:00
parent 110d8a0419
commit 945dd1a809
1466 changed files with 374820 additions and 0 deletions
+28
View File
@@ -0,0 +1,28 @@
#
SHELL=/bin/sh
subdirs=compile_tests format_tests perform_tests seqio_tests \
call_tests condition_tests idxio_tests search_tests sortio_tests
nist_modules=NC IX SM
tests:
perl cobol_test.pl
clean:
@for i in ${subdirs}; do \
echo -n Cleaning in directory $$i ; \
(cd $$i; rm -f *.s *.o *.lis* *.scan *.txt *.dat core libcalls.a temp*cob) ; \
echo " (done)" ; \
done
@echo -n Cleaning in directory ./
@rm -f foo* basic.c* *.log temp*cob
@echo " (done)"
nist_test:
@for i in ${nist_modules}; do \
echo -n Testing in directory nist/$$i ; \
(cd nist/$$i; make -k -i -f ../Makefile_$$i >make.log 2>maker.log; cd ..) ; \
echo " (done)" ; \
done
(cd nist; diff nist.rpt nist_prev.rpt;)
+53
View File
@@ -0,0 +1,53 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. PTEST01.
AUTHOR. Bernard GIROUD.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 05-AUG-2000.
DATE-COMPILED.
SECURITY. NONE.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 PARM01 PIC X(20) VALUE "ABCDEFGHIJ0123456789".
01 PARM02.
05 FILLER PIC X(4) VALUE "ABCD".
05 FILLER PIC X VALUE LOW-VALUE.
01 PARM03.
05 FILLER PIC X(4) VALUE "0123".
05 FILLER PIC X VALUE LOW-VALUE.
01 PARM04.
05 FILLER PIC X(4) VALUE "EFGH".
05 FILLER PIC X VALUE LOW-VALUE.
01 PARM05.
05 FILLER PIC X(4) VALUE "4567".
05 FILLER PIC X VALUE LOW-VALUE.
01 RES1.
05 EPARM02 PIC X(4).
05 EPARM03 PIC X(4).
05 EPARM04 PIC X(4).
05 EPARM05 PIC X(4).
PROCEDURE DIVISION.
CALL "STEST01" USING PARM01.
DISPLAY "C002:(" PARM01 "):(9876543210JIHGFEDCBA):"
"Call by reference x(20).".
MOVE "ABCDEFGHIJ0123456789" TO PARM01.
CALL "STEST03" USING BY CONTENT PARM01.
DISPLAY "C004:(" PARM01 "):(ABCDEFGHIJ0123456789):"
"Call by content x(20).".
CALL "STEST910" USING PARM02 BY CONTENT PARM03
BY REFERENCE PARM04 BY CONTENT PARM05.
MOVE PARM02 TO EPARM02.
MOVE PARM03 TO EPARM03.
MOVE PARM04 TO EPARM04.
MOVE PARM05 TO EPARM05.
DISPLAY "C005:(" RES1 "):(AB9D0123EF9H4567):"
"Call by ref and by content in alternance x(4).".
STOP RUN.
+68
View File
@@ -0,0 +1,68 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. PTEST02.
AUTHOR. Bernard GIROUD.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 05-AUG-2000.
DATE-COMPILED.
SECURITY. NONE.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 G-PARM01.
05 PARM01 PIC X(20) VALUE "TEST".
05 FILLER PIC X VALUE LOW-VALUE.
01 PARM03 PIC S9(9) COMP VALUE 0.
01 G-PARM02.
05 PARM02 PIC X(3).
05 FILLER PIC X VALUE LOW-VALUE.
01 G-PARM04.
05 PARM04 PIC X(3).
05 FILLER PIC X VALUE LOW-VALUE.
01 PARM05 PIC S9(18) COMP.
01 RPARM05 REDEFINES PARM05.
05 RPAR05L PIC S9(9) COMP.
05 RPAR05H PIC S9(9) COMP.
01 WRES01 PIC S9(4) COMP.
01 WRES02 PIC S9(9) COMP.
01 WERES01 PIC 9(4).
01 WERES02 PIC 9(9).
01 WS-COB EXTERNAL.
05 WS-B4 PIC S9(9) COMP.
05 WS-B2 PIC S9(4) COMP.
05 WS-CHAR3 PIC X(3).
PROCEDURE DIVISION.
MOVE "ABCDEFGHIJ0123456789" TO PARM01.
MOVE "XYZ" TO PARM02.
MOVE "123" TO PARM04.
MOVE 0 TO PARM03.
CALL "STEST901" USING G-PARM01.
MOVE 3 TO PARM03.
CALL "STEST902" USING BY VALUE PARM03.
CALL "STEST903" USING BY VALUE 5.
CALL "STEST904" USING G-PARM02 BY VALUE PARM03 5
BY REFERENCE G-PARM02 G-PARM04.
CALL "STEST905" USING BY VALUE 1234567890123.
MOVE 1234567890123 TO PARM05.
CALL "STEST906" USING BY VALUE PARM05.
CALL "STEST907" USING BY VALUE 5 RETURNING WRES01.
MOVE WRES01 TO WERES01.
DISPLAY "C201:(" WERES01 "):(0008):Returning short".
CALL "STEST908" USING BY VALUE 5 RETURNING WRES02.
MOVE WRES02 TO WERES02.
DISPLAY "C202:(" WERES02 "):(000000008):Returning long".
* CALL "STEST909" USING BY VALUE 5 RETURNING PARM05.
MOVE "USD" TO WS-CHAR3.
MOVE 1234 TO WS-B2.
MOVE 6789 TO WS-B4.
CALL "STEST930".
STOP RUN.
+46
View File
@@ -0,0 +1,46 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. PTEST03.
AUTHOR. Bernard GIROUD.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 03-SEP-2000.
DATE-COMPILED.
SECURITY. NONE.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 W-IDX PIC 99.
01 W-ELEM1 PIC X(5).
01 W-BINARY PIC S9(9) COMP.
01 W-GROUP1.
05 FILLER PIC X(3).
05 W-ELEM2 PIC X(4).
05 W-GTAB.
10 W-CHAR OCCURS 4 PIC X.
01 WFUNC PIC 9.
01 WVAL PIC 99.
PROCEDURE DIVISION.
MOVE "ABCD" TO W-ELEM1.
MOVE "CDEF" TO W-ELEM2.
MOVE 4 TO W-BINARY.
DISPLAY "MR01:(" W-ELEM1 "):(ABCD ):ELEM1".
DISPLAY "MR02:(" W-ELEM2 "):(CDEF):ELEM2".
MOVE SPACE TO W-GTAB.
MOVE "X" TO W-CHAR(2).
DISPLAY "MR03:(" W-GTAB "):( X ):OCCURS LIT".
MOVE SPACE TO W-GTAB.
MOVE 3 TO W-IDX.
MOVE "X" TO W-CHAR(W-IDX).
DISPLAY "MR04:(" W-GTAB "):( X ):OCCURS VAR".
MOVE 1 TO WFUNC.
MOVE 2 TO WVAL.
CALL "STEST02" USING WFUNC WVAL.
CALL "STEST02" USING WFUNC WVAL.
MOVE 2 TO WFUNC.
CALL "STEST02" USING WFUNC WVAL.
STOP RUN.
+31
View File
@@ -0,0 +1,31 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. PTEST04.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 PARM01 PIC X VALUE " ".
01 G-PARM04.
05 PARM04 PIC X(3).
05 FILLER PIC X VALUE LOW-VALUE.
01 WRES01 PIC S9(4) COMP.
01 WRES02 PIC S9(9) COMP.
01 WERES01 PIC 9(4).
01 WERES02 PIC 9(9).
PROCEDURE DIVISION.
MOVE FUNCTION LENGTH(G-PARM04) TO WERES01.
DISPLAY "C401:(" WERES01 "):(0004):Length of group".
MOVE FUNCTION ORD(PARM01) TO WERES01.
DISPLAY "C402:(" WERES01 "):(0033):Ord of var space".
MOVE FUNCTION ORD("A") TO WERES01.
DISPLAY "C403:(" WERES01 "):(0066):Ord of lit A".
* MOVE FUNCTION CHAR(67) TO PARM01.
* DISPLAY "C404:(" PARM01 "):(B):Char of lit 67".
STOP RUN.
+38
View File
@@ -0,0 +1,38 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. PTEST05.
AUTHOR. Bernard GIROUD.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 05-AUG-2000.
DATE-COMPILED.
SECURITY. NONE.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 PARM01 PIC X(20) VALUE "ABCDEFGHIJ0123456789".
01 PARM02.
05 FILLER PIC X(4) VALUE "ABCD".
05 FILLER PIC X VALUE LOW-VALUE.
01 PARM03.
05 FILLER PIC X(4) VALUE "0123".
05 FILLER PIC X VALUE LOW-VALUE.
01 PARM04.
05 FILLER PIC X(4) VALUE "EFGH".
05 FILLER PIC X VALUE LOW-VALUE.
01 PARM05.
05 FILLER PIC X(4) VALUE "4567".
05 FILLER PIC X VALUE LOW-VALUE.
01 RES1.
05 EPARM02 PIC X(4).
05 EPARM03 PIC X(4).
05 EPARM04 PIC X(4).
05 EPARM05 PIC X(4).
PROCEDURE DIVISION.
CALL "STEST04" USING PARM01.
CALL "STEST04" USING PARM01.
STOP RUN.
+25
View File
@@ -0,0 +1,25 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. STEST01.
AUTHOR. Bernard GIROUD.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 05-AUG-2000.
DATE-COMPILED.
SECURITY. NONE.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 PARM01 PIC X(20) VALUE "TEST".
LINKAGE SECTION.
01 L-PARM01 PIC X(20).
PROCEDURE DIVISION USING L-PARM01.
DISPLAY "C001:(" L-PARM01 "):(ABCDEFGHIJ0123456789):"
"Call by reference x(20).".
MOVE "9876543210JIHGFEDCBA" TO L-PARM01.
EXIT PROGRAM.
+29
View File
@@ -0,0 +1,29 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. STEST02.
AUTHOR. Bernard GIROUD.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 05-AUG-2000.
DATE-COMPILED.
SECURITY. NONE.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
* 01 WVAL PIC 99 VALUE "05".
01 WVAL PIC 99 VALUE 05.
LINKAGE SECTION.
01 LFUNC PIC 9.
01 LVAL PIC 99.
PROCEDURE DIVISION USING LFUNC LVAL.
IF LFUNC = 1
ADD LVAL TO WVAL
ELSE
DISPLAY "MR05:(" WVAL "):(09):"
"Static counter.".
EXIT PROGRAM.
+25
View File
@@ -0,0 +1,25 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. STEST03.
AUTHOR. Bernard GIROUD.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 05-AUG-2000.
DATE-COMPILED.
SECURITY. NONE.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 PARM01 PIC X(20) VALUE "TEST".
LINKAGE SECTION.
01 L-PARM01 PIC X(20).
PROCEDURE DIVISION USING L-PARM01.
DISPLAY "C003:(" L-PARM01 "):(ABCDEFGHIJ0123456789):"
"Call by content x(20).".
MOVE "9876543210JIHGFEDCBA" TO L-PARM01.
EXIT PROGRAM.
+25
View File
@@ -0,0 +1,25 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. STEST04 INITIAL PROGRAM.
*PROGRAM-ID. STEST04.
AUTHOR. Bernard GIROUD.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 05-AUG-2000.
DATE-COMPILED.
SECURITY. NONE.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 PARM01 PIC X(04) VALUE "TEST".
LINKAGE SECTION.
01 L-PARM01 PIC X(20).
PROCEDURE DIVISION USING L-PARM01.
DISPLAY "C401:(" PARM01 "):(TEST):" "Initial.".
MOVE SPACE TO PARM01.
EXIT PROGRAM.
+45
View File
@@ -0,0 +1,45 @@
#define EC(n) WS_COB.ws_char3[n]
struct {
int ws_b4;
short ws_b2;
char ws_char3[3];
} WS_COB;
void STEST901(char *s) {
printf("C901:(%20s):(ABCDEFGHIJ0123456789):Call by ref from variable\n", s);
}
void STEST902(int v) {
printf("C902:(%d):(3):Call by value from variable\n", v);
}
void STEST903(int v) {
printf("C903:(%d):(5):Call by value from literal\n", v);
}
void STEST904(char * p1, int p2, int p3, char *p4, char *p5) {
printf("C904:(%3s,%d,%d,%3s,%3s):(XYZ,3,5,XYZ,123):Call modes alternance\n",
p1, p2, p3, p4, p5);
}
void STEST905(long long v) {
printf("C905:(%13lld):(1234567890123):Call by value long long literal\n", v);
}
void STEST906(long long v) {
printf("C906:(%13lld):(1234567890123):Call by value long long var\n", v);
}
short STEST907(long v) {
return v+3;
}
int STEST908(long v) {
return v+3;
}
long long STEST909(long v) {
return v+3;
}
void STEST910(char *s1, char *s2, char *s3, char *s4) {
printf("C910:(%4s%4s%4s%4s):(ABCD0123EFGH4567):Call by ref and content in alternance\n", s1, s2, s3, s4);
s1[2]='9'; s2[2]='9'; s3[2]='9';s4[2]='9';
}
void STEST930() {
EC(0) = 'E'; EC(1) = 'U'; EC(2) = 'R';
WS_COB.ws_b2++;
WS_COB.ws_b4++;
printf("C930:(%c%c%c%04d%04d):(EUR12356790):Received in EXTERNAL from Cobol\n", EC(0), EC(1), EC(2), WS_COB.ws_b2, WS_COB.ws_b4);
}
+5
View File
@@ -0,0 +1,5 @@
ptest01:S:Call by default
ptest02:S:Calling C
ptest03:S:Memory references
ptest04:S:Intrinsic functions
ptest05:S:Initial
+632
View File
@@ -0,0 +1,632 @@
#!/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;
+21
View File
@@ -0,0 +1,21 @@
The source code modules in this directory are intended
for checking the compiler's ability to parse the
source, rather than to check for the proper execution
of compiler output. The test script compiles the source
and checks the return code from the compiler. The
test.script file identifies which programs should
return 0 or return non-zero.
When adding tests to this directory, add an entry
into the test.script with the program base name
followed by a colon then T, F or W. A 'T' indi-
cates that the compiler should return a 0, a 'F'
indicates a non-zero failure code, and a 'W'
indicates that the compiler should return with
compiler warnings.
A sucessful test is a T that compiles clean, a F
that fails to compile, or a W that returns an
error status.
Glen
+21
View File
@@ -0,0 +1,21 @@
PROGRAM-ID. CTEST01_FEATURES.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 11-21-1999.
DATE-COMPILED.
SECURITY. NONE.
* This program should not compile because
* it does not have an identification division
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
PROCEDURE DIVISION.
STOP RUN.
A000-EXIT.
EXIT.
+23
View File
@@ -0,0 +1,23 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST01_FEATURES.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 11-21-1999.
DATE-COMPILED.
SECURITY. NONE.
* This program should not compile because
* it does not have an env div
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
PROCEDURE DIVISION.
STOP RUN.
A000-EXIT.
EXIT.
+19
View File
@@ -0,0 +1,19 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST01_FEATURES.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 11-21-1999.
DATE-COMPILED.
SECURITY. NONE.
* This program will compile even if
* it does not have a DATA DIVISION
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
PROCEDURE DIVISION.
STOP RUN.
A000-EXIT.
EXIT.
+21
View File
@@ -0,0 +1,21 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST01_FEATURES.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 11-21-1999.
DATE-COMPILED.
SECURITY. NONE.
* This program should not compile because
* it does not have a PROC DIV
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
STOP RUN.
A000-EXIT.
EXIT.
+22
View File
@@ -0,0 +1,22 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST01_FEATURES.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 11-21-1999.
DATE-COMPILED.
SECURITY. NONE.
* Are reserved words in comment lines ignored?
* This should not be paresed DATA DIVISION
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
PROCEDURE DIVISION.
STOP RUN.
A000-EXIT.
EXIT.
+16
View File
@@ -0,0 +1,16 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST03.
* AUTHOR. GLEN COLBERT, David Essex.
* ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
* DATA DIVISION.
* FILE SECTION.
* WORKING-STORAGE SECTION.
PROCEDURE DIVISION.
* STOP RUN.
* A000-EXIT.
* EXIT.
+22
View File
@@ -0,0 +1,22 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. TEST1_FORMATS.
AUTHOR. GLEN COLBERT.
INSTALLATION. FOOBAR WIDGETS 1999.
DATE-WRITTEN. 12 November, 1999.
DATE-COMPILED.
SECURITY.
* Note that the REMARKS clause is not part of the ANS COBOL 85 standard.
REMARKS.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
PROCEDURE DIVISION.
STOP RUN.
A000-EXIT.
EXIT.
+26
View File
@@ -0,0 +1,26 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. TEST5_STRUCTURE.
AUTHOR. GLEN COLBERT.
INSTALLATION. FOOBAR WIDGETS 1999.
DATE-WRITTEN. 12 November, 1999.
DATE-COMPILED.
SECURITY.
* Note that the REMARKS clause is not part of the ANS COBOL 85 standard.
REMARKS. CHECK TO SEE THAT THE REMARKS SECTION ALLOWS
MULTI-LINE EXPLANATIONS OF JUST WHAT THE CODE DOES AND
DOES NOT DO. THE COMPILER SHOULD IGNORE EVERYTHING FROM
THE REMARKS TOKEN TO THE NEXT RECOGNIZED SECTION OR
DIVISION HEADER.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
PROCEDURE DIVISION.
STOP RUN.
A000-EXIT.
EXIT.
+34
View File
@@ -0,0 +1,34 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. TEST5_STRUCTURE.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 11-12-1999.
DATE-COMPILED.
SECURITY.
*REMARKS. VALIDATE COMPILE FOR MOVING FIGURATIVE CONSTANTS
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-ALPHANUMERICS.
05 WS-PICX-4 PIC X(4).
05 WS-PICX-6 PIC X(4).
01 WS-NUMERICS.
05 WS-PIC9-4 PIC X(9).
05 WS-PIC9-6 PIC X(9).
PROCEDURE DIVISION.
MOVE ALL "A" TO WS-PICX-4.
MOVE ALL ZEROES TO WS-PIC9-6.
MOVE HIGH-VALUES TO WS-PICX-4.
MOVE LOW-VALUES TO WS-PICX-4.
MOVE QUOTES TO WS-PICX-4.
STOP RUN.
A000-EXIT.
EXIT.
+24
View File
@@ -0,0 +1,24 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST01_PARSE.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 11-21-1999.
DATE-COMPILED.
SECURITY. NONE.
* Parser tests for the ENV DIV
* Does it recognize the section header?
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
PROCEDURE DIVISION.
STOP RUN.
A000-EXIT.
EXIT.
+25
View File
@@ -0,0 +1,25 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST01_PARSE.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 11-21-1999.
DATE-COMPILED.
SECURITY. NONE.
* Parser tests for the ENV DIV
* Does it recognize sourc cp?
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. Linux.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
PROCEDURE DIVISION.
STOP RUN.
A000-EXIT.
EXIT.
+25
View File
@@ -0,0 +1,25 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST01_PARSE.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 11-21-1999.
DATE-COMPILED.
SECURITY. NONE.
* Parser tests for the ENV DIV
* Does it recognize debg md?
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. Linux WITH DEBUGGING MODE.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
PROCEDURE DIVISION.
STOP RUN.
A000-EXIT.
EXIT.
+26
View File
@@ -0,0 +1,26 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST01_PARSE.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 11-21-1999.
DATE-COMPILED.
SECURITY. NONE.
* Parser tests for the ENV DIV
* Does it recognize obj cp?
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. Linux.
OBJECT-COMPUTER. Linux.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
PROCEDURE DIVISION.
STOP RUN.
A000-EXIT.
EXIT.
+25
View File
@@ -0,0 +1,25 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST01_PARSER.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 11-21-1999.
DATE-COMPILED.
SECURITY. NONE.
* test for curncy sgn
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
CURRENCY SIGN IS "$".
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
PROCEDURE DIVISION.
STOP RUN.
A000-EXIT.
EXIT.
+25
View File
@@ -0,0 +1,25 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST01_PARSER.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 11-21-1999.
DATE-COMPILED.
SECURITY. NONE.
* test for curncy sgn
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
PROCEDURE DIVISION.
STOP RUN.
A000-EXIT.
EXIT.
+35
View File
@@ -0,0 +1,35 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST01_FC.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 11-21-1999.
DATE-COMPILED.
SECURITY. NONE.
* Tests for f-c scans.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FOOBAR ASSIGN TO "./foo.bar"
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS WS-FOOBAR-STAT.
DATA DIVISION.
FILE SECTION.
FD FOOBAR
LABEL RECORDS ARE STANDARD.
01 FOOBAR-REC.
05 WS-FOOBAR-KEY PIC 9(2).
05 WS-FOOBAR-DATA1 PIC X(8).
05 WS-FOOBAR-DATA2 PIC X(20).
WORKING-STORAGE SECTION.
01 WS-SWITCHES.
05 WS-FOOBAR-STAT PIC 9(2).
PROCEDURE DIVISION.
STOP RUN.
A000-EXIT.
EXIT.
+35
View File
@@ -0,0 +1,35 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST01_FC.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 11-21-1999.
DATE-COMPILED.
SECURITY. NONE.
* Tests for f-c scans.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FOOBAR ASSIGN TO "./foo.bar"
ORGANIZATION IS LINE SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS WS-FOOBAR-STAT.
DATA DIVISION.
FILE SECTION.
FD FOOBAR
LABEL RECORDS ARE STANDARD.
01 FOOBAR-REC.
05 WS-FOOBAR-KEY PIC 9(2).
05 WS-FOOBAR-DATA1 PIC X(8).
05 WS-FOOBAR-DATA2 PIC X(20).
WORKING-STORAGE SECTION.
01 WS-SWITCHES.
05 WS-FOOBAR-STAT PIC 9(2).
PROCEDURE DIVISION.
STOP RUN.
A000-EXIT.
EXIT.
@@ -0,0 +1,26 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_ACCEPT1.
AUTHOR. STEPHEN CONNOLLY.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* TEST ACCEPT FROM DATE VERB FORMAT.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-DATA PIC X(6).
05 WS-INT1 PIC S9(4) COMP VALUE 4 .
05 WS-INT2 PIC S9(4) COMP VALUE 5 .
05 WS-INT3 PIC S9(9) COMP.
PROCEDURE DIVISION.
000-MAIN.
ACCEPT WS-DATA FROM DATE.
DISPLAY WS-DATA.
STOP RUN.
@@ -0,0 +1,26 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_ACCEPT2.
AUTHOR. STEPHEN CONNOLLY.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* TEST ACCEPT FROM TIME VERB FORMAT.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-DATA PIC X(6).
05 WS-INT1 PIC S9(4) COMP VALUE 4 .
05 WS-INT2 PIC S9(4) COMP VALUE 5 .
05 WS-INT3 PIC S9(9) COMP.
PROCEDURE DIVISION.
000-MAIN.
ACCEPT WS-DATA FROM TIME.
DISPLAY WS-DATA.
STOP RUN.
+31
View File
@@ -0,0 +1,31 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_ADD1.
AUTHOR. STEPHEN CONNOLLY.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* TEST ADD VERB FORMAT 1.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-DATA PIC X(5).
05 WS-INT1 PIC S9(4) COMP VALUE 4 .
05 WS-INT2 PIC S9(4) COMP VALUE 5 .
05 WS-INT3 PIC S9(9) COMP.
PROCEDURE DIVISION.
000-MAIN.
ADD WS-INT1 TO WS-INT2 ROUNDED
ON SIZE ERROR
MOVE "FAIL" TO WS-DATA
NOT ON SIZE ERROR
MOVE "PASS" TO WS-DATA
END-ADD.
DISPLAY WS-DATA.
STOP RUN.
+32
View File
@@ -0,0 +1,32 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_ADD2.
AUTHOR. STEPHEN CONNOLLY.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* TEST ADD VERB FORMAT 2.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-DATA PIC X(5).
05 WS-INT1 PIC S9(4) COMP VALUE 4 .
05 WS-INT2 PIC S9(4) COMP VALUE 5 .
05 WS-INT3 PIC S9(9) COMP.
PROCEDURE DIVISION.
000-MAIN.
ADD WS-INT1 TO WS-INT2
GIVING WS-INT3 ROUNDED
ON SIZE ERROR
MOVE "FAIL" TO WS-DATA
NOT ON SIZE ERROR
MOVE "PASS" TO WS-DATA
END-ADD.
DISPLAY WS-DATA.
STOP RUN.
+42
View File
@@ -0,0 +1,42 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_ADD3.
AUTHOR. STEPHEN CONNOLLY.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* TEST ADD VERB FORMAT 3.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-DATA PIC X(5).
05 WS-INT1 PIC S9(4) COMP VALUE 4 .
05 WS-INT2 PIC S9(4) COMP VALUE 5 .
05 WS-INT3 PIC S9(9) COMP.
01 WS-VARIABLE2.
05 WS-INT1 PIC S9(4) COMP VALUE 4 .
05 WS-INT2 PIC S9(4) COMP VALUE 5 .
PROCEDURE DIVISION.
000-MAIN.
ADD CORRESPONDING WS-INT1 of WS-VARIABLES TO WS-INT2 of WS-VARIABLES ROUNDED
ON SIZE ERROR
MOVE "FAIL" TO WS-DATA of WS-VARIABLES
NOT ON SIZE ERROR
MOVE "PASS" TO WS-DATA OF WS-VARIABLES
END-ADD.
DISPLAY WS-DATA OF WS-VARIABLES.
ADD CORR WS-INT1 OF WS-VARIABLES TO WS-INT2 OF WS-VARIABLES ROUNDED
ON SIZE ERROR
MOVE "FAIL" TO WS-DATA OF WS-VARIABLES
NOT ON SIZE ERROR
MOVE "PASS" TO WS-DATA of WS-VARIABLES
END-ADD.
DISPLAY WS-DATA of WS-VARIABLES.
STOP RUN.
@@ -0,0 +1,34 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_CLOSE1.
ENVIRONMENT DIVISION.
* TEST CLOSE WITH LOCK VERB FORMAT
CONFIGURATION SECTION.
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT GOZOUT ASSIGN TO "./input.dat"
ORGANIZATION IS SEQUENTIAL
ACCESS IS SEQUENTIAL
FILE STATUS IS FS.
DATA DIVISION.
FILE SECTION.
FD GOZOUT
LABEL RECORD IS STANDARD.
01 GOZOUT-REC.
03 X-IND PIC 9(03).
03 DESCRIPTION PIC X(20).
03 FILLER PIC X(57).
WORKING-STORAGE SECTION.
01 FS PIC 9(02).
01 WS-COUNTERS.
05 WS-TEST-COUNTER PIC 9(4).
PROCEDURE DIVISION.
000-MAIN.
OPEN OUTPUT GOZOUT.
CLOSE GOZOUT WITH LOCK.
STOP RUN.
@@ -0,0 +1,31 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_COMPUTE1.
AUTHOR. STEPHEN CONNOLLY.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* TEST COMPUTE VERB.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-DATA PIC X(5).
05 WS-INT1 PIC S9(4) COMP VALUE 4 .
05 WS-INT2 PIC S9(4) COMP VALUE 5 .
05 WS-INT3 PIC S9(9) COMP.
PROCEDURE DIVISION.
000-MAIN.
COMPUTE WS-INT3 ROUNDED = WS-INT1 + WS-INT2
ON SIZE ERROR
MOVE "FAIL" TO WS-DATA
* NOT ON SIZE ERROR
* MOVE "PASS" TO WS-DATA
END-COMPUTE.
DISPLAY WS-DATA.
STOP RUN.
@@ -0,0 +1,31 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_CONTINUE1.
AUTHOR. STEPHEN CONNOLLY.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* TEST CONTINUE VERB.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-DATA PIC X(5).
05 WS-INT1 PIC S9(4) COMP VALUE 4 .
05 WS-INT2 PIC S9(4) COMP VALUE 5 .
05 WS-INT3 PIC S9(9) COMP.
PROCEDURE DIVISION.
000-MAIN.
MOVE "PASS" TO WS-DATA.
IF WS-INT1 > 0
CONTINUE
ELSE
MOVE "FAIL" TO WS-DATA
END-IF.
DISPLAY WS-DATA.
STOP RUN.
@@ -0,0 +1,37 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_DELETE1.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT ARQ ASSIGN TO "Testing.dat"
ORGANIZATION IS INDEXED
ACCESS MODE IS RANDOM
RECORD KEY IS X-IND
FILE STATUS IS FS.
DATA DIVISION.
FILE SECTION.
FD ARQ
LABEL RECORD IS STANDARD.
01 REG-ARQ.
03 X-IND PIC 9(03).
03 DESCRIPTION PIC X(60).
WORKING-STORAGE SECTION.
01 FS PIC 9(02).
01 ARQ-KEY PIC 9(03).
PROCEDURE DIVISION.
000-MAIN.
OPEN I-O ARQ.
READ ARQ.
DELETE ARQ RECORD
INVALID KEY
MOVE "FAIL" TO DESCRIPTION
NOT INVALID KEY
MOVE "PASS" TO DESCRIPTION
END-DELETE.
CLOSE ARQ.
@@ -0,0 +1,31 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_DIVIDE1.
AUTHOR. STEPHEN CONNOLLY.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* TEST DIVIDE VERB FORMAT 1.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-DATA PIC X(5).
05 WS-INT1 PIC S9(4) COMP VALUE 4 .
05 WS-INT2 PIC S9(4) COMP VALUE 5 .
05 WS-INT3 PIC S9(9) COMP.
PROCEDURE DIVISION.
000-MAIN.
DIVIDE WS-INT1 INTO WS-INT2 ROUNDED
ON SIZE ERROR
MOVE "FAIL" TO WS-DATA
* NOT ON SIZE ERROR
* MOVE "PASS" TO WS-DATA
END-DIVIDE.
DISPLAY WS-DATA.
STOP RUN.
@@ -0,0 +1,32 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_DIVIDE2.
AUTHOR. STEPHEN CONNOLLY.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* TEST DIVIDE VERB FORMAT 2.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-DATA PIC X(5).
05 WS-INT1 PIC S9(4) COMP VALUE 4 .
05 WS-INT2 PIC S9(4) COMP VALUE 5 .
05 WS-INT3 PIC S9(9) COMP.
PROCEDURE DIVISION.
000-MAIN.
DIVIDE WS-INT1 INTO WS-INT2
GIVING WS-INT3 ROUNDED
ON SIZE ERROR
MOVE "FAIL" TO WS-DATA
* NOT ON SIZE ERROR
* MOVE "PASS" TO WS-DATA
END-DIVIDE.
DISPLAY WS-DATA.
STOP RUN.
@@ -0,0 +1,32 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_DIVIDE3.
AUTHOR. STEPHEN CONNOLLY.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* TEST DIVIDE VERB FORMAT 3.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-DATA PIC X(5).
05 WS-INT1 PIC S9(4) COMP VALUE 4 .
05 WS-INT2 PIC S9(4) COMP VALUE 5 .
05 WS-INT3 PIC S9(9) COMP.
PROCEDURE DIVISION.
000-MAIN.
DIVIDE WS-INT1 BY WS-INT2
GIVING WS-INT3 ROUNDED
ON SIZE ERROR
MOVE "FAIL" TO WS-DATA
* NOT ON SIZE ERROR
* MOVE "PASS" TO WS-DATA
END-DIVIDE.
DISPLAY WS-DATA.
STOP RUN.
@@ -0,0 +1,34 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_DIVIDE4.
AUTHOR. STEPHEN CONNOLLY.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* TEST DIVIDE VERB FORMAT 4.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-DATA PIC X(5).
05 WS-INT1 PIC S9(4) COMP VALUE 4 .
05 WS-INT2 PIC S9(4) COMP VALUE 5 .
05 WS-INT3 PIC S9(9) COMP.
05 WS-INT4 PIC S9(9) COMP.
PROCEDURE DIVISION.
000-MAIN.
DIVIDE WS-INT1 INTO WS-INT2
GIVING WS-INT3 ROUNDED
REMAINDER WS-INT4
ON SIZE ERROR
MOVE "FAIL" TO WS-DATA
* NOT ON SIZE ERROR
* MOVE "PASS" TO WS-DATA
END-DIVIDE.
DISPLAY WS-DATA.
STOP RUN.
@@ -0,0 +1,34 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_DIVIDE5.
AUTHOR. STEPHEN CONNOLLY.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* TEST DIVIDE VERB FORMAT 5.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-DATA PIC X(5).
05 WS-INT1 PIC S9(4) COMP VALUE 4 .
05 WS-INT2 PIC S9(4) COMP VALUE 5 .
05 WS-INT3 PIC S9(9) COMP.
05 WS-INT4 PIC S9(9) COMP.
PROCEDURE DIVISION.
000-MAIN.
DIVIDE WS-INT1 BY WS-INT2
GIVING WS-INT3 ROUNDED
REMAINDER WS-INT4
ON SIZE ERROR
MOVE "FAIL" TO WS-DATA
NOT ON SIZE ERROR
MOVE "PASS" TO WS-DATA
END-DIVIDE.
DISPLAY WS-DATA.
STOP RUN.
+37
View File
@@ -0,0 +1,37 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_GOTO1.
AUTHOR. STEPHEN CONNOLLY.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* TEST GO TO DEPENDING ON VERB FORMAT.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-DATA PIC X(5).
05 WS-INT0 PIC 999 VALUE 4 .
05 WS-INT1 PIC S9(4) COMP VALUE 4 .
05 WS-INT2 PIC S9(4) COMP VALUE 5 .
05 WS-INT3 PIC S9(9) COMP.
PROCEDURE DIVISION.
000-MAIN.
GO TO A1, A2 A3 DEPENDING ON WS-INT0.
DISPLAY "FAIL"
GO TO A4.
A1.
DISPLAY "PASS A1"
GO TO A4.
A2.
DISPLAY "PASS A2"
GO TO A4.
A3.
DISPLAY "PASS A3".
A4.
STOP RUN.
@@ -0,0 +1,31 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_INITIALIZE1.
AUTHOR. STEPHEN CONNOLLY.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* TEST INITIALIZE VERB FULL FORMAT.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-DATA PIC X(5).
05 WS-INT1 PIC S9(4) COMP VALUE 4 .
05 WS-INT2 PIC S9(4) COMP VALUE 5 .
05 WS-INT3 PIC S9(9) COMP.
05 WS-INT4 PIC S9(9) COMP.
PROCEDURE DIVISION.
000-MAIN.
INITIALIZE WS-VARIABLES
REPLACING ALPHABETIC DATA BY "A"
ALPHANUMERIC DATA BY "0"
NUMERIC DATA BY ZEROES
ALPHANUMERIC-EDITED DATA BY SPACES
NUMERIC-EDITED BY ZEROES.
STOP RUN.
@@ -0,0 +1,31 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_MULTIPLY1.
AUTHOR. STEPHEN CONNOLLY.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* TEST MULTIPLY VERB FORMAT 1.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-DATA PIC X(5).
05 WS-INT1 PIC S9(4) COMP VALUE 4 .
05 WS-INT2 PIC S9(4) COMP VALUE 5 .
05 WS-INT3 PIC S9(9) COMP.
PROCEDURE DIVISION.
000-MAIN.
MULTIPLY WS-INT1 BY WS-INT2 ROUNDED
ON SIZE ERROR
MOVE "FAIL" TO WS-DATA
NOT ON SIZE ERROR
MOVE "PASS" TO WS-DATA
END-MULTIPLY.
DISPLAY WS-DATA.
STOP RUN.
@@ -0,0 +1,32 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_MULTIPLY2.
AUTHOR. STEPHEN CONNOLLY.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* TEST MULTIPLY VERB FORMAT 2.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-DATA PIC X(5).
05 WS-INT1 PIC S9(4) COMP VALUE 4 .
05 WS-INT2 PIC S9(4) COMP VALUE 5 .
05 WS-INT3 PIC S9(9) COMP.
PROCEDURE DIVISION.
000-MAIN.
MULTIPLY WS-INT1 BY WS-INT2
GIVING WS-INT3 ROUNDED
ON SIZE ERROR
MOVE "FAIL" TO WS-DATA
* NOT ON SIZE ERROR
* MOVE "PASS" TO WS-DATA
END-MULTIPLY.
DISPLAY WS-DATA.
STOP RUN.
+38
View File
@@ -0,0 +1,38 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_OPEN1.
AUTHOR. STEPHEN CONNOLLY.
INSTALLATION. Tiny Cobol Compiler Project.
DATE-WRITTEN. 11-21-1999.
DATE-COMPILED.
SECURITY. NONE.
* TEST OPEN VERB FULL FORMAT.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FOOBAR ASSIGN TO "./foo.bar"
ORGANIZATION IS LINE SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS WS-FS1.
DATA DIVISION.
FILE SECTION.
FD FOOBAR
LABEL RECORDS ARE STANDARD.
01 FOOBAR-REC.
05 WS-FOOBAR-KEY PIC 9(2).
05 WS-FOOBAR-DATA1 PIC X(8).
05 WS-FOOBAR-DATA2 PIC X(20).
WORKING-STORAGE SECTION.
01 WS-SWITCHES.
05 WS-FS1 PIC 9(2).
PROCEDURE DIVISION.
000-MAIN.
OPEN INPUT FOOBAR
OUTPUT FOOBAR
I-O FOOBAR
EXTEND FOOBAR
.
STOP RUN.
+43
View File
@@ -0,0 +1,43 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_READ1.
ENVIRONMENT DIVISION.
* TEST READ VERB FORMAT 1 (SEQUENTIAL).
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT GOZOUT
ASSIGN TO "./input.dat"
ORGANIZATION IS SEQUENTIAL
ACCESS IS SEQUENTIAL
FILE STATUS IS FS.
DATA DIVISION.
FILE SECTION.
FD GOZOUT
LABEL RECORD IS STANDARD.
01 GOZOUT-REC.
03 X-IND PIC 9(03).
03 DESCRIPTION PIC X(20).
03 FILLER PIC X(57).
WORKING-STORAGE SECTION.
01 FS PIC 9(02).
01 WS-COUNTERS.
05 WS-TEST-COUNTER PIC 9(4).
01 WS-DATA PIC X(80).
01 WS-NAME PIC X(80).
PROCEDURE DIVISION.
0000-MAIN.
MOVE "./INPUT.DAT" TO WS-NAME.
OPEN OUTPUT GOZOUT.
READ GOZOUT NEXT RECORD INTO WS-DATA
AT END
MOVE "FAIL" TO DESCRIPTION
* NOT AT END
* MOVE "PASS" TO DESCRIPTION
END-READ.
CLOSE GOZOUT.
STOP RUN.
+45
View File
@@ -0,0 +1,45 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_READ2.
ENVIRONMENT DIVISION.
* TEST READ VERB FORMAT 2 (RELATIVE).
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT GOZOUT
ASSIGN TO "FILLER "
ORGANIZATION IS RELATIVE
ACCESS IS RANDOM
RELATIVE KEY IS WS-RECORD-NO
FILE STATUS IS FS.
DATA DIVISION.
FILE SECTION.
FD GOZOUT
LABEL RECORD IS STANDARD.
01 GOZOUT-REC.
03 X-IND PIC 9(03).
03 DESCRIPTION PIC X(20).
03 FILLER PIC X(57).
WORKING-STORAGE SECTION.
01 FS PIC 9(02).
01 WS-COUNTERS.
05 WS-TEST-COUNTER PIC 9(4).
01 WS-DATA PIC X(80).
01 WS-NAME PIC X(80) VALUE "./input.dat" .
01 WS-RECORD-NO PIC 9(9) COMP VALUE 0 .
PROCEDURE DIVISION.
0000-MAIN.
OPEN OUTPUT GOZOUT.
MOVE 1001 TO WS-RECORD-NO
READ GOZOUT NEXT RECORD INTO WS-DATA
INVALID KEY
MOVE "FAIL" TO DESCRIPTION
* NOT INVALID KEY
* MOVE "PASS" TO DESCRIPTION
END-READ.
CLOSE GOZOUT.
STOP RUN.
+45
View File
@@ -0,0 +1,45 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_READ3.
ENVIRONMENT DIVISION.
* TEST READ VERB FORMAT 3 (RANDOM).
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT GOZOUT
ASSIGN TO "FILLER "
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS RANDOM
RELATIVE KEY IS X-IND
FILE STATUS IS FS.
DATA DIVISION.
FILE SECTION.
FD GOZOUT
LABEL RECORD IS STANDARD.
01 GOZOUT-REC.
03 X-IND PIC 9(03).
03 DESCRIPTION PIC X(20).
03 FILLER PIC X(57).
WORKING-STORAGE SECTION.
01 FS PIC 9(02).
01 WS-COUNTERS.
05 WS-TEST-COUNTER PIC 9(4).
01 WS-DATA PIC X(80).
01 WS-NAME PIC X(80) VALUE "./input.dat" .
01 WS-RECORD-NO PIC 9(9) COMP VALUE 0 .
PROCEDURE DIVISION.
0000-MAIN.
OPEN INPUT GOZOUT.
MOVE 101 TO X-IND
READ GOZOUT RECORD INTO WS-DATA
INVALID KEY
MOVE "FAIL" TO DESCRIPTION
* NOT INVALID KEY
* MOVE "PASS" TO DESCRIPTION
END-READ.
CLOSE GOZOUT.
STOP RUN.
+46
View File
@@ -0,0 +1,46 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_READ4.
ENVIRONMENT DIVISION.
* TEST READ VERB FORMAT 4 (INDEXED).
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT GOZOUT
ASSIGN TO "FILLER "
ORGANIZATION IS INDEXED
ACCESS IS DYNAMIC
RECORD KEY IS X-IND
FILE STATUS IS FS.
DATA DIVISION.
FILE SECTION.
FD GOZOUT
LABEL RECORD IS STANDARD.
01 GOZOUT-REC.
03 X-IND PIC 9(03).
03 DESCRIPTION PIC X(20).
03 FILLER PIC X(57).
WORKING-STORAGE SECTION.
01 FS PIC 9(02).
01 WS-COUNTERS.
05 WS-TEST-COUNTER PIC 9(4).
01 WS-DATA PIC X(80).
01 WS-NAME PIC X(80) VALUE "./input.dat" .
01 WS-RECORD-NO PIC 9(9) COMP VALUE 0 .
PROCEDURE DIVISION.
0000-MAIN.
OPEN OUTPUT GOZOUT.
MOVE 101 TO X-IND
READ GOZOUT RECORD INTO WS-DATA
KEY IS X-IND
INVALID KEY
MOVE "FAIL" TO DESCRIPTION
* NOT INVALID KEY
* MOVE "PASS" TO DESCRIPTION
END-READ.
CLOSE GOZOUT.
STOP RUN.
@@ -0,0 +1,39 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_REWRITE1.
ENVIRONMENT DIVISION.
* TEST REWRITE VERB FORMAT 1 (SEQUENTIAL).
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT OPTIONAL GOZOUT
ASSIGN TO "./input.dat" USING WS-NAME
ORGANIZATION IS SEQUENTIAL
ACCESS IS SEQUENTIAL
FILE STATUS IS FS.
DATA DIVISION.
FILE SECTION.
FD GOZOUT
LABEL RECORD IS STANDARD.
01 GOZOUT-REC.
03 X-IND PIC 9(03).
03 DESCRIPTION PIC X(20).
03 FILLER PIC X(57).
WORKING-STORAGE SECTION.
01 FS PIC 9(02).
01 WS-COUNTERS.
05 WS-TEST-COUNTER PIC 9(4).
01 WS-DATA PIC X(80).
01 WS-NAME PIC X(80).
PROCEDURE DIVISION.
0000-MAIN.
OPEN OUTPUT GOZOUT.
REWRITE GOZOUT
FROM WS-DATA
END-REWRITE.
CLOSE GOZOUT.
STOP RUN.
@@ -0,0 +1,45 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_REWRITE2.
ENVIRONMENT DIVISION.
* TEST REWRITE VERB FORMAT 2 (INDEXED).
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT OPTIONAL GOZOUT
ASSIGN TO "FILLER " USING WS-NAME
ORGANIZATION IS INDEXED
ACCESS IS DYNAMIC
RECORD KEY IS X-IND WITH DUPLICATES
ALTERNATE RECORD KEY IS DESCRIPTION
WITH DUPLICATES
FILE STATUS IS FS.
DATA DIVISION.
FILE SECTION.
FD GOZOUT
LABEL RECORD IS STANDARD.
01 GOZOUT-REC.
03 X-IND PIC 9(03).
03 DESCRIPTION PIC X(20).
03 FILLER PIC X(57).
WORKING-STORAGE SECTION.
01 FS PIC 9(02).
01 WS-COUNTERS.
05 WS-TEST-COUNTER PIC 9(4).
01 WS-DATA PIC X(80).
01 WS-NAME PIC X(80) VALUE "./input.dat" .
01 WS-RECORD-NO PIC 9(9) COMP VALUE 0 .
PROCEDURE DIVISION.
0000-MAIN.
OPEN OUTPUT GOZOUT.
MOVE 101 TO X-IND
REWRITE GOZOUT FROM WS-DATA
INVALID KEY
MOVE "FAIL" TO DESCRIPTION
END-REWRITE.
CLOSE GOZOUT.
STOP RUN.
@@ -0,0 +1,27 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_SEARCH1.
ENVIRONMENT DIVISION.
* TEST SEARCH VERB FORMAT 1.
CONFIGURATION SECTION.
* INPUT-OUTPUT SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-XX PIC XX.
01 WS-TABLE1.
05 TB1-ENTRY OCCURS 20 TIMES
INDEXED BY TB1-IDX.
10 TB1-VALUE PIC X(2).
PROCEDURE DIVISION.
0000-MAIN.
SET TB1-IDX TO 1.
MOVE "JJ" TO WS-XX.
SEARCH TB1-ENTRY VARYING TB1-IDX
AT END
DISPLAY "FAIL"
WHEN TB1-VALUE(TB1-IDX) = WS-XX
DISPLAY "PASS"
END-SEARCH.
STOP RUN.
@@ -0,0 +1,30 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_SEARCH2.
ENVIRONMENT DIVISION.
* TEST SEARCH VERB FORMAT 2.
CONFIGURATION SECTION.
* INPUT-OUTPUT SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 TABLE-AREA PIC X(40) VALUE
"AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTT".
01 TABLE1 REDEFINES TABLE-AREA.
05 TB1-ENTRY OCCURS 20 TIMES
ASCENDING KEY IS TB1-VALUE
INDEXED BY TB1-IDX
.
10 TB1-VALUE PIC X(2).
01 WS-XX PIC XX.
PROCEDURE DIVISION.
0000-MAIN.
MOVE "JJ" TO WS-XX.
SEARCH ALL TB1-ENTRY
AT END
DISPLAY "FAIL"
WHEN TB1-VALUE(TB1-IDX) = WS-XX
DISPLAY "PASS"
END-SEARCH.
STOP RUN.
+36
View File
@@ -0,0 +1,36 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_SET1.
ENVIRONMENT DIVISION.
* TEST SET VERB ALL FORMATS .
CONFIGURATION SECTION.
* SPECIAL-NAMES.
* SW0 IS SORT-SWITCH
* ON STATUS IS SORT-ON
* OFF STATUS IS SORT-OFF.
* INPUT-OUTPUT SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 TABLE-AREA PIC X(40) VALUE
"AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTT".
01 TABLE1 REDEFINES TABLE-AREA.
05 TB1-ENTRY OCCURS 20 TIMES
INDEXED BY TB1-IDX.
10 TB1-VALUE PIC X(2).
01 WS-XX PIC XX.
88 VALID-DATA VALUE "JJ".
01 WS-INT PIC S9(4) COMP VALUE 10 .
PROCEDURE DIVISION.
0000-MAIN.
SET TB1-IDX TO 1.
SET TB1-IDX UP BY WS-INT.
SET TB1-IDX DOWN BY WS-INT.
* SET SORT-SWITCH TO ON.
MOVE "AA" TO WS-XX.
SET VALID-DATA TO TRUE.
STOP RUN.
@@ -0,0 +1,45 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_START1.
ENVIRONMENT DIVISION.
* TEST START VERB FORMAT.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT GOZOUT
ASSIGN TO "FILLER "
ORGANIZATION IS INDEXED
ACCESS IS DYNAMIC
RECORD KEY IS X-IND
FILE STATUS IS FS.
DATA DIVISION.
FILE SECTION.
FD GOZOUT
LABEL RECORD IS STANDARD.
01 GOZOUT-REC.
03 X-IND PIC 9(03).
03 DESCRIPTION PIC X(20).
03 FILLER PIC X(57).
WORKING-STORAGE SECTION.
01 FS PIC 9(02).
01 WS-COUNTERS.
05 WS-TEST-COUNTER PIC 9(4).
01 WS-DATA PIC X(80).
01 WS-NAME PIC X(80) VALUE "./input.dat" .
01 WS-RECORD-NO PIC 9(9) COMP VALUE 0 .
PROCEDURE DIVISION.
0000-MAIN.
OPEN OUTPUT GOZOUT.
MOVE 101 TO X-IND
START GOZOUT KEY IS EQUAL TO WS-RECORD-NO
INVALID KEY
MOVE "FAIL" TO DESCRIPTION
* NOT INVALID KEY
* MOVE "PASS" TO DESCRIPTION
END-START.
CLOSE GOZOUT.
STOP RUN.
@@ -0,0 +1,23 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_STRING1.
ENVIRONMENT DIVISION.
* TEST STRING VERB .
CONFIGURATION SECTION.
* INPUT-OUTPUT SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 TABLE-AREA PIC X(40) VALUE SPACES.
01 WS-XX PIC XX VALUE "AA".
01 WS-POINTER PIC S9(4) COMP.
PROCEDURE DIVISION.
0000-MAIN.
STRING WS-XX DELIMITED BY SIZE
INTO TABLE-AREA
WITH POINTER WS-POINTER
ON OVERFLOW
DISPLAY "FAIL"
END-STRING.
STOP RUN.
@@ -0,0 +1,31 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_SUBTRACT1.
AUTHOR. STEPHEN CONNOLLY.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* TEST SUBTRACT VERB FORMAT 1.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-DATA PIC X(5).
05 WS-INT1 PIC S9(4) COMP VALUE 4 .
05 WS-INT2 PIC S9(4) COMP VALUE 5 .
05 WS-INT3 PIC S9(9) COMP.
PROCEDURE DIVISION.
000-MAIN.
SUBTRACT WS-INT1 FROM WS-INT2 ROUNDED
ON SIZE ERROR
MOVE "FAIL" TO WS-DATA
* NOT ON SIZE ERROR
* MOVE "PASS" TO WS-DATA
END-SUBTRACT.
DISPLAY WS-DATA.
STOP RUN.
@@ -0,0 +1,32 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_SUBTRACT2.
AUTHOR. STEPHEN CONNOLLY.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* TEST SUBTRACT VERB FORMAT 2.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-DATA PIC X(5).
05 WS-INT1 PIC S9(4) COMP VALUE 4 .
05 WS-INT2 PIC S9(4) COMP VALUE 5 .
05 WS-INT3 PIC S9(9) COMP.
PROCEDURE DIVISION.
000-MAIN.
SUBTRACT WS-INT1 FROM WS-INT2
GIVING WS-INT3 ROUNDED
ON SIZE ERROR
MOVE "FAIL" TO WS-DATA
* NOT ON SIZE ERROR
* MOVE "PASS" TO WS-DATA
END-SUBTRACT.
DISPLAY WS-DATA.
STOP RUN.
@@ -0,0 +1,42 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_SUBTRACT3.
AUTHOR. STEPHEN CONNOLLY.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* TEST SUBTRACT VERB FORMAT 3.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-DATA PIC X(5).
05 WS-INT1 PIC S9(4) COMP VALUE 4 .
05 WS-INT2 PIC S9(4) COMP VALUE 5 .
05 WS-INT3 PIC S9(9) COMP.
01 WS-VARIABLE2.
05 WS-INT1 PIC S9(4) COMP VALUE 4 .
05 WS-INT2 PIC S9(4) COMP VALUE 5 .
PROCEDURE DIVISION.
000-MAIN.
SUBTRACT CORRESPONDING WS-INT1 of WS-VARIABLES FROM WS-INT2 of WS-VARIABLES ROUNDED
ON SIZE ERROR
MOVE "FAIL" TO WS-DATA of WS-VARIABLES
NOT ON SIZE ERROR
MOVE "PASS" TO WS-DATA of WS-VARIABLES
END-SUBTRACT.
DISPLAY WS-DATA of WS-VARIABLES.
SUBTRACT CORR WS-INT1 of WS-VARIABLES FROM WS-INT2 of WS-VARIABLES ROUNDED
ON SIZE ERROR
MOVE "FAIL" TO WS-DATA of WS-VARIABLES
* NOT ON SIZE ERROR
* MOVE "PASS" TO WS-DATA
END-SUBTRACT.
DISPLAY WS-DATA of WS-VARIABLES.
STOP RUN.
@@ -0,0 +1,31 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTP_UNSTRING1.
ENVIRONMENT DIVISION.
* TEST UNSTRING VERB .
CONFIGURATION SECTION.
* INPUT-OUTPUT SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 TABLE-AREA PIC X(40) VALUE "12 43 56".
01 WS-XX1 PIC XX VALUE SPACES.
01 WS-XX2 PIC XX VALUE SPACES.
01 WS-POINTER PIC S9(4) COMP.
01 WS-COUNT PIC S9(4) COMP.
01 WS-TALLY PIC S9(4) COMP.
PROCEDURE DIVISION.
0000-MAIN.
UNSTRING TABLE-AREA
DELIMITED BY
ALL SPACES OR ALL ","
INTO WS-XX1
DELIMITER IN WS-XX2
COUNT IN WS-COUNT
WITH POINTER WS-POINTER
TALLYING IN WS-TALLY
ON OVERFLOW
DISPLAY "FAIL"
END-UNSTRING.
STOP RUN.
+35
View File
@@ -0,0 +1,35 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTWS13.
ENVIRONMENT DIVISION.
* TEST SELECT FORMAT 1 (SEQUENTIAL).
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT GOZOUT
ASSIGN TO "./input.dat"
ORGANIZATION IS SEQUENTIAL
ACCESS IS SEQUENTIAL
FILE STATUS IS FS.
DATA DIVISION.
FILE SECTION.
FD GOZOUT
LABEL RECORD IS STANDARD.
01 GOZOUT-REC.
03 X-IND PIC 9(03).
03 DESCRIPTION PIC X(20).
03 FILLER PIC X(57).
WORKING-STORAGE SECTION.
01 FS PIC 9(02).
01 WS-COUNTERS.
05 WS-TEST-COUNTER PIC 9(4).
01 WS-DATA PIC X(80).
01 WS-NAME PIC X(80).
PROCEDURE DIVISION.
0000-MAIN.
MOVE "./INPUT.DAT" TO WS-NAME.
STOP RUN.
+36
View File
@@ -0,0 +1,36 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTWS14.
ENVIRONMENT DIVISION.
* TEST SELECT VERB FULL FORMAT 1 (SEQUENTIAL).
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT OPTIONAL GOZOUT
ASSIGN TO "./input.dat"
USING WS-NAME
ORGANIZATION IS SEQUENTIAL
ACCESS IS SEQUENTIAL
FILE STATUS IS FS.
DATA DIVISION.
FILE SECTION.
FD GOZOUT
LABEL RECORD IS STANDARD.
01 GOZOUT-REC.
03 X-IND PIC 9(03).
03 DESCRIPTION PIC X(20).
03 FILLER PIC X(57).
WORKING-STORAGE SECTION.
01 FS PIC 9(02).
01 WS-COUNTERS.
05 WS-TEST-COUNTER PIC 9(4).
01 WS-DATA PIC X(80).
01 WS-NAME PIC X(80).
PROCEDURE DIVISION.
0000-MAIN.
MOVE "./INPUT.DAT" TO WS-NAME.
STOP RUN.
+36
View File
@@ -0,0 +1,36 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTWS15.
ENVIRONMENT DIVISION.
* TEST SELECT FORMAT 2 (RELATIVE).
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT GOZOUT
ASSIGN TO "FILLER "
ORGANIZATION IS RELATIVE
ACCESS IS RANDOM
RELATIVE KEY IS WS-RECORD-NO
FILE STATUS IS FS.
DATA DIVISION.
FILE SECTION.
FD GOZOUT
LABEL RECORD IS STANDARD.
01 GOZOUT-REC.
03 X-IND PIC 9(03).
03 DESCRIPTION PIC X(20).
03 FILLER PIC X(57).
WORKING-STORAGE SECTION.
01 FS PIC 9(02).
01 WS-COUNTERS.
05 WS-TEST-COUNTER PIC 9(4).
01 WS-DATA PIC X(80).
01 WS-NAME PIC X(80) VALUE "./input.dat" .
01 WS-RECORD-NO PIC 9(9) COMP VALUE 0 .
PROCEDURE DIVISION.
0000-MAIN.
STOP RUN.
+36
View File
@@ -0,0 +1,36 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTWS16.
ENVIRONMENT DIVISION.
* TEST SELECT FULL FORMAT 2 (RELATIVE).
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT OPTIONAL GOZOUT
ASSIGN TO "FILLER " USING WS-NAME
ORGANIZATION IS RELATIVE
ACCESS IS RANDOM
RELATIVE KEY IS WS-RECORD-NO
FILE STATUS IS FS.
DATA DIVISION.
FILE SECTION.
FD GOZOUT
LABEL RECORD IS STANDARD.
01 GOZOUT-REC.
03 X-IND PIC 9(03).
03 DESCRIPTION PIC X(20).
03 FILLER PIC X(57).
WORKING-STORAGE SECTION.
01 FS PIC 9(02).
01 WS-COUNTERS.
05 WS-TEST-COUNTER PIC 9(4).
01 WS-DATA PIC X(80).
01 WS-NAME PIC X(80) VALUE "./input.dat" .
01 WS-RECORD-NO PIC 9(9) COMP VALUE 0 .
PROCEDURE DIVISION.
0000-MAIN.
STOP RUN.
+36
View File
@@ -0,0 +1,36 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTWS17.
ENVIRONMENT DIVISION.
* TEST SELECT FORMAT 3 (RANDOM).
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT GOZOUT
ASSIGN TO "FILLER "
* ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS RANDOM
* RELATIVE KEY IS X-IND
FILE STATUS IS FS.
DATA DIVISION.
FILE SECTION.
FD GOZOUT
LABEL RECORD IS STANDARD.
01 GOZOUT-REC.
03 X-IND PIC 9(03).
03 DESCRIPTION PIC X(20).
03 FILLER PIC X(57).
WORKING-STORAGE SECTION.
01 FS PIC 9(02).
01 WS-COUNTERS.
05 WS-TEST-COUNTER PIC 9(4).
01 WS-DATA PIC X(80).
01 WS-NAME PIC X(80) VALUE "./input.dat" .
01 WS-RECORD-NO PIC 9(9) COMP VALUE 0 .
PROCEDURE DIVISION.
0000-MAIN.
STOP RUN.
+36
View File
@@ -0,0 +1,36 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTWS18.
ENVIRONMENT DIVISION.
* TEST SELECT FULL FORMAT 3 (RANDOM).
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT OPTIONAL GOZOUT
ASSIGN TO "FILLER " USING WS-NAME
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS RANDOM
RELATIVE KEY IS X-IND
FILE STATUS IS FS.
DATA DIVISION.
FILE SECTION.
FD GOZOUT
LABEL RECORD IS STANDARD.
01 GOZOUT-REC.
03 X-IND PIC 9(03).
03 DESCRIPTION PIC X(20).
03 FILLER PIC X(57).
WORKING-STORAGE SECTION.
01 FS PIC 9(02).
01 WS-COUNTERS.
05 WS-TEST-COUNTER PIC 9(4).
01 WS-DATA PIC X(80).
01 WS-NAME PIC X(80) VALUE "./input.dat" .
01 WS-RECORD-NO PIC 9(9) COMP VALUE 0 .
PROCEDURE DIVISION.
0000-MAIN.
STOP RUN.
+36
View File
@@ -0,0 +1,36 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTWS19.
ENVIRONMENT DIVISION.
* TEST SELECT FORMAT 4 (INDEXED).
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT GOZOUT
ASSIGN TO "FILLER "
ORGANIZATION IS INDEXED
ACCESS IS DYNAMIC
RECORD KEY IS X-IND
FILE STATUS IS FS.
DATA DIVISION.
FILE SECTION.
FD GOZOUT
LABEL RECORD IS STANDARD.
01 GOZOUT-REC.
03 X-IND PIC 9(03).
03 DESCRIPTION PIC X(20).
03 FILLER PIC X(57).
WORKING-STORAGE SECTION.
01 FS PIC 9(02).
01 WS-COUNTERS.
05 WS-TEST-COUNTER PIC 9(4).
01 WS-DATA PIC X(80).
01 WS-NAME PIC X(80) VALUE "./input.dat" .
01 WS-RECORD-NO PIC 9(9) COMP VALUE 0 .
PROCEDURE DIVISION.
0000-MAIN.
STOP RUN.
+37
View File
@@ -0,0 +1,37 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTESTWS20.
ENVIRONMENT DIVISION.
* TEST SELECT FULL FORMAT 4 (INDEXED).
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT OPTIONAL GOZOUT
ASSIGN TO "FILLER " USING WS-NAME
ORGANIZATION IS INDEXED
ACCESS IS DYNAMIC
RECORD KEY IS X-IND
ALTERNATE RECORD KEY IS DESCRIPTION
WITH DUPLICATES
FILE STATUS IS FS.
DATA DIVISION.
FILE SECTION.
FD GOZOUT
LABEL RECORD IS STANDARD.
01 GOZOUT-REC.
03 X-IND PIC 9(03).
03 DESCRIPTION PIC X(20).
03 FILLER PIC X(57).
WORKING-STORAGE SECTION.
01 FS PIC 9(02).
01 WS-COUNTERS.
05 WS-TEST-COUNTER PIC 9(4).
01 WS-DATA PIC X(80).
01 WS-NAME PIC X(80) VALUE "./input.dat" .
01 WS-RECORD-NO PIC 9(9) COMP VALUE 0 .
PROCEDURE DIVISION.
STOP RUN.
+22
View File
@@ -0,0 +1,22 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST_PIX.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* Pares tests for pictures.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-LARGE-PICX PIC X(5000).
PROCEDURE DIVISION.
STOP RUN.
A000-EXIT.
EXIT.
+31
View File
@@ -0,0 +1,31 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST_PIX.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* Pares tests for pictures.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
* Maximun elementary alphanumeric size is 12750
* This limit can be overcome by using groups items
01 WS-VARIABLES.
* 05 WS-LARGE-PICX PIC X(51000).
05 WS-LARGE-PICX PIC X(12750).
05 FILLER PIC X(12750).
05 FILLER PIC X(12750).
05 FILLER PIC X(12750).
01 WS-VARIABLES1.
05 WS-LARGE-PICX1 PIC X(12750) OCCURS 100.
PROCEDURE DIVISION.
STOP RUN.
A000-EXIT.
EXIT.
+22
View File
@@ -0,0 +1,22 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST_PIX.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* Pares tests for pictures.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-LARGE-PIC9 PIC 9(42).
PROCEDURE DIVISION.
STOP RUN.
A000-EXIT.
EXIT.
+22
View File
@@ -0,0 +1,22 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST_PIX.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* Pares tests for pictures.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-LARGE-PIC9 PIC 9(16).
PROCEDURE DIVISION.
STOP RUN.
A000-EXIT.
EXIT.
+27
View File
@@ -0,0 +1,27 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST_PIX.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* Pares tests for pictures.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-LARGE-PIC9 PIC 9(16)
USAGE IS COMPUTATIONAL.
05 WS-NORMAL-PIC9 PIC 9(6)
USAGE IS COMP.
PROCEDURE DIVISION.
MOVE 0 TO WS-LARGE-PIC9.
MOVE 0 TO WS-NORMAL-PIC9.
STOP RUN.
A000-EXIT.
EXIT.
+33
View File
@@ -0,0 +1,33 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST_PIX.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* Pares tests for pictures.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-LARGE-P1 USAGE IS COMPUTATIONAL-2.
05 WS-LARGE-P2 USAGE IS COMP-2.
05 WS-NORMAL-P1 USAGE IS COMPUTATIONAL-1.
05 WS-NORMAL-P2 USAGE IS COMP-1.
05 WS-NORMAL-P3 USAGE IS FLOAT-SHORT.
05 WS-LARGE-P3 USAGE IS FLOAT-LONG.
PROCEDURE DIVISION.
MOVE 1.1 TO WS-LARGE-P1.
MOVE 2.2 TO WS-LARGE-P2.
MOVE 3.3 TO WS-NORMAL-P1.
MOVE 4.4 TO WS-NORMAL-P2.
MOVE 5.5 TO WS-NORMAL-P3.
MOVE 6.6 TO WS-LARGE-P3.
STOP RUN.
A000-EXIT.
EXIT.
+27
View File
@@ -0,0 +1,27 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST_PIX.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* Pares tests for pictures.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-LARGE-PIC9 PIC 9(16)
USAGE IS COMPUTATIONAL-3.
05 WS-NORMAL-PIC9 PIC 9(6)
USAGE IS COMP-3.
PROCEDURE DIVISION.
MOVE 0 TO WS-LARGE-PIC9.
MOVE 0 TO WS-NORMAL-PIC9.
STOP RUN.
A000-EXIT.
EXIT.
+27
View File
@@ -0,0 +1,27 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST_PIX.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* Pares tests for pictures.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-LARGE-PIC9 PIC 9(16)
USAGE IS PACKED-DECIMAL.
05 WS-NORMAL-PIC9 PIC 9(6)
USAGE IS PACKED-DECIMAL.
PROCEDURE DIVISION.
MOVE 0 TO WS-LARGE-PIC9.
MOVE 0 TO WS-NORMAL-PIC9.
STOP RUN.
A000-EXIT.
EXIT.
+27
View File
@@ -0,0 +1,27 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST_PIX.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* Pares tests for pictures.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-LARGE-PIC9 PIC 9(16)
USAGE IS DISPLAY.
05 WS-NORMAL-PIC9 PIC 9(6)
USAGE IS DISPLAY.
PROCEDURE DIVISION.
MOVE 0 TO WS-LARGE-PIC9.
MOVE 0 TO WS-NORMAL-PIC9.
STOP RUN.
A000-EXIT.
EXIT.
+27
View File
@@ -0,0 +1,27 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST_PIX.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* Pares tests for pictures.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-LARGE-PIC9 PIC S9(16)
USAGE IS DISPLAY.
05 WS-NORMAL-PIC9 PIC S9(6)
USAGE IS DISPLAY.
PROCEDURE DIVISION.
MOVE 0 TO WS-LARGE-PIC9.
MOVE 0 TO WS-NORMAL-PIC9.
STOP RUN.
A000-EXIT.
EXIT.
+27
View File
@@ -0,0 +1,27 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST_PIX.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* Pares tests for pictures.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-LARGE-PIC9 PIC S9(16)
USAGE IS COMPUTATIONAL.
05 WS-NORMAL-PIC9 PIC S9(6)
USAGE IS COMP.
PROCEDURE DIVISION.
MOVE 0 TO WS-LARGE-PIC9.
MOVE 0 TO WS-NORMAL-PIC9.
STOP RUN.
A000-EXIT.
EXIT.
+27
View File
@@ -0,0 +1,27 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST_PIX.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* Pares tests for pictures.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-LARGE-PIC9 PIC S9(16)
USAGE IS COMPUTATIONAL-3.
05 WS-NORMAL-PIC9 PIC S9(6)
USAGE IS COMP-3.
PROCEDURE DIVISION.
MOVE 0 TO WS-LARGE-PIC9.
MOVE 0 TO WS-NORMAL-PIC9.
STOP RUN.
A000-EXIT.
EXIT.
+22
View File
@@ -0,0 +1,22 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. CTEST_PIX.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Compiler Project.
SECURITY. NONE.
* Pares tests for pictures.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-VARIABLES.
05 WS-LARGE-PICX PIC X(5000).
PROCEDURE DIVISION.
STOP RUN.
A000-EXIT.
EXIT.
+81
View File
@@ -0,0 +1,81 @@
ctest01:F:C001:Compile of empty file (cob)
ctest01a:F:CI01:Missing IDENTIFICATION DIVISION
ctest01b:F:CI02:Missing ENVIRONMENT DIVISION
#ctest01c:F:CI03:Missing DATA DIVISION
ctest01c:T:CI03:Missing DATA DIVISION
ctest01d:F:CI04:Missing PROCEDURE DIVISION
ctest01e:T:CI05:Reserved words in comments
ctest02:F:C002:Compile of empty file (cbl)
#
ctestws01:T:WS01:Large PICX test
ctestws02:T:WS02:Larger PICX test
ctestws03:F:WS03:Too Large PIC9 test
ctestws04:T:WS04:Large PIC9 test
ctestws05:T:WS05:Usage is COMP
ctestws06:T:WS06:Usage is SIGNED FLOAT (SHORT/LONG/COMP-1/COMP-2)
ctestws07:T:WS07:Usage is COMP-3
ctestws08:T:WS08:Usage is PACKED-DECIMAL
ctestws09:T:WS09:Usage is DISPLAY
ctestws10:T:WS10:Usage is SIGNED DISPLAY
ctestws11:T:WS11:Usage is SIGNED COMP
ctestws12:T:WS12:Usage is SIGNED COMP-3
#
ctested01:T:CI06:Recognize CONFIGURATION SECTION
ctested02:T:CI07:Recognize SOURCE COMPUTER
ctested03:T:CI08:Recognize DEBUGGING MODE
ctested04:T:CI09:Recognize OBJECT COMPUTER
ctested05:T:CI10:Recognize CURRENCY SIGN
ctested06:T:CI10:Recognize DECIMAL-POINT
# ctested07:T:CI10:Recognize CLASS
ctestfc01:T:CF01:Simple File Control
ctestfc02:T:CF01:Sequential Line Mode
ctest03:T:C003:Minimum Cobol structure - no logic
ctest04:T:C004:Identification Division Test 1
ctest05:T:C004:Permit multi-line remarks
ctest06:T:C005:Compile for figurative constants
#
# SELECT file
#
ctestsl01:T:SL01:Recognize simple SELECT (SEQUENTIAL)
ctestsl02:T:SL02:Recognize full SELECT (SEQUENTIAL)
ctestsl03:T:SL03:Recognize simple SELECT (RELATIVE)
ctestsl04:T:SL04:Recognize full SELECT (RELATIVE)
ctestsl05:T:SL05:Recognize simple SELECT (RANDOM)
ctestsl06:T:SL06:Recognize full SELECT (RANDOM)
ctestsl07:T:SL07:Recognize simple SELECT (INDEXED)
ctestsl08:T:SL08:Recognize full SELECT (INDEXED)
#
# PROCEDURE DIVISION VERBS
#
ctestp-accept1:T:CPA1:Recognize ACCEPT FROM DATE verb format
ctestp-accept2:T:CPA2:Recognize ACCEPT FROM TIME verb format
ctestp-add1:T:CPA7:Recognize ADD verb format 1 (TO)
ctestp-add2:T:CPA8:Recognize ADD verb format 2 (TO GIVING)
ctestp-add3:T:CPA9:Recognize ADD verb format 3 (CORRESPONDING)
ctestp-close1:T:CPC1:Recognize CLOSE WITH LOCK verb format
ctestp-compute1:T:CPC2:Recognize COMPUTE verb
ctestp-continue1:T:CPC3:Recognize CONTINUE verb
ctestp-delete1:T:CPD2:Recognize DELETE verb full format
ctestp-divide1:T:CPD2:Recognize DIVIDE verb format 1 (INTO)
ctestp-divide2:T:CPD3:Recognize DIVIDE verb format 2 (INTO GIVING)
ctestp-divide3:T:CPD4:Recognize DIVIDE verb format 3 (BY GIVING)
ctestp-divide4:T:CPD5:Recognize DIVIDE verb format 4 (INTO REMAINDER)
ctestp-divide5:T:CPD6:Recognize DIVIDE verb format 5 (BY REMAINDER)
ctestp-goto1:T:CPG1:Recognize GO TO DEPENDING ON verb format
ctestp-initialize1:T:CPI1:Recognize INITIALIZE verb full format
ctestp-multiply1:T:CPM1:Recognize MULTIPLY verb format 1 (BY)
ctestp-multiply2:T:CPM2:Recognize MULTIPLY verb format 2 (BY GIVING)
ctestp-open1:T:CPO1:Recognize OPEN verb full format
ctestp-read1:T:CPR1:Recognize READ verb format 1 (SEQUENTIAL)
ctestp-read2:T:CPR2:Recognize READ verb format 2 (RELATIVE)
ctestp-read3:T:CPR3:Recognize READ verb format 3 (RANDOM)
ctestp-read4:T:CPR4:Recognize READ verb format 3 (INDEXED)
ctestp-subtract1:T:CPS1:Recognize SUBTRACT verb format 1 (FROM)
ctestp-subtract2:T:CPS2:Recognize SUBTRACT verb format 2 (FROM GIVING)
ctestp-subtract3:T:CPS3:Recognize SUBTRACT verb format 3 (CORRESPONDING)
ctestp-search1:T:CPS4:Recognize SEARCH verb format 1 (VARYING)
ctestp-search2:T:CPS5:Recognize SEARCH verb format 2 (ALL)
ctestp-set1:T:CPS6:Recognize SET verb all formats
ctestp-start1:T:CPS7:Recognize START verb full format
ctestp-string1:T:CPS8:Recognize STRING verb full format
ctestp-unstring1:T:CPU1:Recognize UNSTRING verb full format
+190
View File
@@ -0,0 +1,190 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. COND01.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-IDX PIC 9(3).
01 WS-IDX1 PIC 9(3).
01 WS-IDX2 PIC 9(3).
01 IDX PIC 9(3).
01 IDX2 PIC 9(3) COMP.
01 WS-AGE-GROUP PIC 9(2).
88 WS-MINOR VALUE 1 THRU 18.
88 WS-YADULT VALUE 19, 20, 21, 22.
88 WS-ADULT VALUE 21 THRU 99.
01 WS-DEPT-GROUP1 PIC X.
88 WS-ACCOUNTING1 VALUE 'A', 'B', 'C'.
88 WS-OTHER1 VALUE 'D' THRU 'Z'.
01 WS-DEPT-GROUP PIC 9.
88 WS-ACCOUNTING VALUE 2, 3.
88 WS-OTHER VALUE 4 THRU 9.
01 WS-STATUS PIC X(1).
88 WS-DIVORCED VALUE 'D'.
88 WS-MARRIED VALUE 'M'.
88 WS-SINGLE VALUE 'S'.
01 WS-FULL-NAME PIC X(20).
01 WS-NUMBER pic X(10).
01 WS-IF-TRACE PIC 9.
PROCEDURE DIVISION.
A-000.
DISPLAY "BEGIN: IF/ELSE TESTS".
MOVE 1 TO IDX.
MOVE 99 TO WS-IDX.
MOVE 1 TO WS-IDX1.
MOVE 2 TO WS-IDX2.
MOVE 'M' TO WS-STATUS.
MOVE 21 TO WS-AGE-GROUP.
MOVE 'DAVID ESSEX' TO WS-FULL-NAME.
MOVE "1234" TO WS-NUMBER.
MOVE 2 TO WS-DEPT-GROUP.
MOVE 'A' TO WS-DEPT-GROUP1.
PERFORM A-100.
PERFORM A-200.
PERFORM A-300.
PERFORM A-400.
PERFORM A-500.
PERFORM A-600.
PERFORM A-650.
PERFORM A-700.
PERFORM A-750.
PERFORM A-800.
PERFORM A-900.
PERFORM A-1000.
PERFORM A-1100.
PERFORM A-1200.
STOP RUN.
A-100.
IF ( WS-IDX1 EQUAL 1 ) AND ( WS-IDX2 EQUAL 2 )
THEN
MOVE 1 TO WS-IF-TRACE
ELSE
MOVE 2 TO WS-IF-TRACE
END-IF.
DISPLAY "IF01:(" WS-IF-TRACE "):(1):(And)".
A-200.
IF WS-IDX1 EQUAL 3
MOVE 1 TO WS-IF-TRACE
ELSE
MOVE 2 TO WS-IF-TRACE
END-IF.
DISPLAY "IF02:(" WS-IF-TRACE "):(2):(Simple)".
A-300.
IF WS-IDX EQUAL 99
MOVE 1 TO WS-IF-TRACE
ELSE
MOVE 2 TO WS-IF-TRACE.
DISPLAY "IF03:(" WS-IF-TRACE "):(1):(Simple 2 pos)".
A-400.
IF WS-IDX NOT EQUAL 99
MOVE 1 TO WS-IF-TRACE
ELSE
MOVE 2 TO WS-IF-TRACE
END-IF.
DISPLAY "IF04:(" WS-IF-TRACE "):(2):(Simple ne)".
A-500.
IF WS-MARRIED
MOVE 1 TO WS-IF-TRACE
ELSE
MOVE 2 TO WS-IF-TRACE.
DISPLAY "IF05:(" WS-IF-TRACE "):(1):(Simple condition)".
A-600.
IF WS-ADULT
MOVE 1 TO WS-IF-TRACE
ELSE
MOVE 2 TO WS-IF-TRACE.
DISPLAY "IF06:(" WS-IF-TRACE "):(1):(Simple condition)".
A-650.
IF WS-YADULT
MOVE 1 TO WS-IF-TRACE
ELSE
MOVE 2 TO WS-IF-TRACE.
DISPLAY "IF07:(" WS-IF-TRACE "):(1):(Simple condition)".
A-700.
IF WS-FULL-NAME NUMERIC
MOVE 1 TO WS-IF-TRACE
IF WS-FULL-NAME ALPHABETIC
MOVE 2 TO WS-IF-TRACE
ELSE
MOVE 3 TO WS-IF-TRACE.
DISPLAY "IF08:(" WS-IF-TRACE "):(1):(Simple class alpha)".
A-750.
IF WS-NUMBER NUMERIC
MOVE 1 TO WS-IF-TRACE
ELSE
MOVE 2 TO WS-IF-TRACE.
DISPLAY "IF09:(" WS-IF-TRACE "):(1):(Simple class num)".
A-800.
IF WS-IDX POSITIVE
MOVE 1 TO WS-IF-TRACE
ELSE
MOVE 2 TO WS-IF-TRACE.
DISPLAY "IF10:(" WS-IF-TRACE "):(1):(Simple class signed)".
A-900.
MOVE WS-IDX1 TO WS-IDX2.
ADD 50 TO WS-IDX2.
IF WS-IDX = WS-IDX1 + 50
MOVE 1 TO WS-IF-TRACE
ELSE
MOVE 2 TO WS-IF-TRACE.
DISPLAY "IF11:(" WS-IF-TRACE "):(2):(Arith expression)".
A-1000.
IF WS-ACCOUNTING
MOVE 1 TO WS-IF-TRACE
ELSE
MOVE 2 TO WS-IF-TRACE.
DISPLAY "IF12:(" WS-IF-TRACE "):(1):(Simple)".
A-1100.
IF WS-ACCOUNTING1
MOVE 1 TO WS-IF-TRACE
ELSE
MOVE 2 TO WS-IF-TRACE.
DISPLAY "IF13:(" WS-IF-TRACE "):(1):(Simple)".
A-1200.
IF WS-IDX > WS-IDX1 OR > IDX
THEN
MOVE 1 TO WS-IF-TRACE
ELSE
MOVE 2 TO WS-IF-TRACE
END-IF
DISPLAY "IF14:(" WS-IF-TRACE "):(1):(Combined OR)".
A-1300.
MOVE ZEROS TO WS-NUMBER
IF WS-NUMBER IS ZEROS
THEN
MOVE 1 TO WS-IF-TRACE
ELSE
MOVE 2 TO WS-IF-TRACE
END-IF
DISPLAY "IF15:(" WS-IF-TRACE "):(1):(all zeros)".
+187
View File
@@ -0,0 +1,187 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. COND03.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-A100 PIC 9(3).
01 WS-A200 PIC 9(3).
01 WS-AGE-GROUP PIC 9(2).
88 WS-MINOR VALUE 1 THRU 18.
88 WS-YADULT VALUE 19, 20.
88 WS-ADULT VALUE 21 THRU 99.
01 DATA-VALIDATION PIC 9.
88 DATA-ISVALID VALUE 0.
88 DATA-NOTNUMERIC VALUE 1.
88 DATA-ISOUTOFBOUNDS VALUE 2.
01 WS-TOT-TRACE.
05 WS-EV-TRACE PIC 9(2).
05 WS-Z-TRACE PIC 9.
01 WS-EXPECTED PIC 9(3).
PROCEDURE DIVISION.
A-000.
MOVE 1 TO WS-A100.
PERFORM A-100.
MOVE 8 TO WS-A100.
PERFORM A-150.
MOVE 0 TO WS-Z-TRACE.
MOVE 2 TO WS-A200.
PERFORM A-200.
MOVE 10 TO WS-EV-TRACE.
MOVE 140 TO WS-EXPECTED.
MOVE 2 TO WS-A200.
PERFORM A-250.
MOVE 20 TO WS-EV-TRACE.
MOVE 220 TO WS-EXPECTED.
MOVE 12 TO WS-A200.
PERFORM A-250.
MOVE 30 TO WS-EV-TRACE.
MOVE 340 TO WS-EXPECTED.
MOVE 166 TO WS-A200.
PERFORM A-250.
MOVE 19 TO WS-AGE-GROUP.
PERFORM A-300.
PERFORM A-400.
PERFORM A-500.
MOVE 0 TO DATA-VALIDATION.
PERFORM A-600.
MOVE 0 TO DATA-VALIDATION.
PERFORM A-700.
STOP RUN.
A-100.
MOVE 0 TO WS-Z-TRACE.
EVALUATE WS-A100
WHEN 1
MOVE 1 TO WS-EV-TRACE
PERFORM Z-900 THRU Z-910
WHEN 2
MOVE 2 TO WS-EV-TRACE
PERFORM Z-910 THRU Z-920
WHEN OTHER
MOVE 3 TO WS-EV-TRACE
END-EVALUATE.
DISPLAY "EV01:(" WS-TOT-TRACE "):(013):(Simple)".
A-150.
MOVE 0 TO WS-Z-TRACE.
EVALUATE WS-A100
WHEN 1
WHEN 2
WHEN 3
WHEN 5
WHEN 7
MOVE 1 TO WS-EV-TRACE
PERFORM Z-900 THRU Z-910
WHEN 4
WHEN 6
WHEN 8
MOVE 2 TO WS-EV-TRACE
PERFORM Z-910 THRU Z-920
WHEN OTHER
MOVE 3 TO WS-EV-TRACE
END-EVALUATE.
DISPLAY "EV02:(" WS-TOT-TRACE "):(026):(Multiple WHEN)".
A-200.
EVALUATE WS-A200
WHEN 1 THRU 10
MOVE 1 TO WS-EV-TRACE
WHEN 11 THRU 99
MOVE 2 TO WS-EV-TRACE
WHEN OTHER
MOVE 3 TO WS-EV-TRACE
END-EVALUATE.
DISPLAY "EV03:(" WS-TOT-TRACE "):(010):(THRU conditions)".
A-250.
EVALUATE WS-A200
WHEN 6 THRU 10
ADD 1 TO WS-EV-TRACE
WHEN 11 THRU 99
ADD 2 TO WS-EV-TRACE
WHEN OTHER
ADD 4 TO WS-EV-TRACE
END-EVALUATE.
DISPLAY "EV04:(" WS-TOT-TRACE "):(" WS-EXPECTED
"):(THRU conditions, OTHER branch)".
A-300.
EVALUATE WS-AGE-GROUP
WHEN WS-MINOR
MOVE 1 TO WS-EV-TRACE
WHEN WS-YADULT
MOVE 2 TO WS-EV-TRACE
WHEN WS-ADULT
MOVE 3 TO WS-EV-TRACE
WHEN OTHER
MOVE 4 TO WS-EV-TRACE
END-EVALUATE.
DISPLAY "EV05:(" WS-TOT-TRACE "):(020):(88 conditions)".
A-400.
EVALUATE WS-AGE-GROUP <= 20
WHEN TRUE
MOVE 1 TO WS-EV-TRACE
WHEN FALSE
MOVE 2 TO WS-EV-TRACE
END-EVALUATE.
DISPLAY "EV06:(" WS-TOT-TRACE "):(010):(88 conditions)".
A-500.
EVALUATE WS-A100 ALSO WS-A200
WHEN 1 ALSO 1 THRU 10
MOVE 1 TO WS-EV-TRACE
WHEN 2 ALSO 11 THRU 99
MOVE 2 TO WS-EV-TRACE
WHEN OTHER
MOVE 3 TO WS-EV-TRACE
END-EVALUATE.
DISPLAY "EV07:(" WS-TOT-TRACE "):(030):(ALSO conditions)".
A-600.
EVALUATE TRUE
WHEN DATA-ISVALID
MOVE 1 TO WS-EV-TRACE
WHEN DATA-NOTNUMERIC
MOVE 2 TO WS-EV-TRACE
WHEN DATA-ISOUTOFBOUNDS
MOVE 3 TO WS-EV-TRACE
WHEN OTHER
MOVE 4 TO WS-EV-TRACE
END-EVALUATE.
DISPLAY "EV08:(" WS-TOT-TRACE "):(010):(Simple 88)".
A-700.
IF DATA-ISVALID
THEN
MOVE 1 TO WS-EV-TRACE
ELSE
MOVE 2 TO WS-EV-TRACE
END-IF.
DISPLAY "EV09:(" WS-TOT-TRACE "):(010):(IF 88 condition)".
Z-900.
ADD 1 TO WS-Z-TRACE.
Z-910.
ADD 2 TO WS-Z-TRACE.
Z-920.
ADD 4 TO WS-Z-TRACE.
+2
View File
@@ -0,0 +1,2 @@
cond01:S:If::
cond03:S:Evaluate::
+19
View File
@@ -0,0 +1,19 @@
#
#
#
test01:S:Validate Alph to Alphanumeric moves
test01a:S:Validate Alpha to Formatted Alphanumeric (space) moves
test01b:S:Validate Alpha to Formatted Alphanumeric (slash) moves
test01c:S:Validate COMP (binary integer) and INDEX moves
test02a:S:Validate Alphanumeric to Alpha/numeric edited moves
test02b:S:Validate Alphanumeric to Numeric edited moves
test03a:S:Validate Numeric Integer moves
test03b:S:Validate Numeric Integer to Edited moves
test03c:S:Floating Insertion Edited Move tests
test03d:S:Non-default currency sign Edited moves
test04:S:Fixed numeric insertion tests
test05a:S:Figurative Constants move tests
test05b:S:Initialize statement
test06a:S:Reference Modifiers
test07a:S:Qualified move and arithmetic tests
test08a:S:Unstring tests
+82
View File
@@ -0,0 +1,82 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. TEST1_FORMATS.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Project
DATE-WRITTEN. 12 November, 1999.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-ALPHA-FIELDS.
05 WS-ALPHA-1 PIC A(01).
05 WS-ALPHA-2 PIC A(02).
05 WS-ALPHA-3 PIC A(03).
05 WS-ALPHA-4 PIC A(04).
05 WS-ALPHA-5 PIC A(05).
05 WS-ALPHA-6 PIC A(06).
05 WS-ALPHA-7 PIC A(07).
05 WS-ALPHA-26 PIC X(26).
01 WS-ALPHANUM-FIELDS.
05 WS-ALPHANUM-1 PIC X(01).
05 WS-ALPHANUM-2 PIC X(02).
05 WS-ALPHANUM-3 PIC X(03).
05 WS-ALPHANUM-4 PIC X(04).
05 WS-ALPHANUM-5 PIC X(05).
05 WS-ALPHANUM-6 PIC X(06).
05 WS-ALPHANUM-8 PIC X(08) JUST RIGHT.
01 WS-ALPHA-EDIT-FIELDS.
05 WS-ANE-1 PIC XXBXXX.
05 WS-ANE-2 PIC XBXX.
05 WS-ANE-3 PIC XX/XXX.
05 WS-ANE-4 PIC X/XX.
05 WS-ANE-5 PIC XXBXXBXX.
05 WS-ANE-6 PIC XX/XX/XX.
PROCEDURE DIVISION.
0000-PROGRAM-ENTRY-POINT.
DISPLAY "TEST1_FORMATS.program entry."
PERFORM A000-ALPHANUMERIC-TESTS THRU A000-EXIT.
STOP RUN.
A000-ALPHANUMERIC-TESTS.
MOVE "ABCDEFGHIJKLMONPQRSTUVWXYZ"
TO WS-ALPHA-26.
A001-TEST.
MOVE "A" TO WS-ALPHA-1.
MOVE WS-ALPHA-1 TO WS-ALPHANUM-6.
DISPLAY "A001:(" WS-ALPHANUM-6 "):(A ):"
"ALPHA LEFT ALIGN TEST MOVE A(1) TO X(6)".
MOVE "ABCDE" TO WS-ALPHA-5.
MOVE WS-ALPHA-5 TO WS-ALPHANUM-6.
DISPLAY "A002:(" WS-ALPHANUM-6 "):(ABCDE ):"
"ALPHA LEFT ALIGN MOVE TEST MOVE A(5) TO X(6)".
MOVE "ABCDEF" TO WS-ALPHA-6.
MOVE WS-ALPHA-6 TO WS-ALPHANUM-6.
DISPLAY "A003:(" WS-ALPHANUM-6 "):(ABCDEF):"
"ALPHA LEFT ALIGN MOVE TEST MOVE A(6) TO X(6)".
MOVE WS-ALPHA-26 TO WS-ALPHANUM-6.
DISPLAY "A004:(" WS-ALPHANUM-6 "):(ABCDEF):"
"ALPHA LEFT ALIGN MOVE TEST MOVE A(26) TO X(6)".
MOVE "ABCDEFGHIJ" TO WS-ALPHANUM-8.
DISPLAY "A005:(" WS-ALPHANUM-8 "):(CDEFGHIJ):"
"MOVE ABCDEFGHIJ TO X(8) RIGHT".
MOVE "ABCDE" TO WS-ALPHANUM-8.
DISPLAY "A006:(" WS-ALPHANUM-8 "):( ABCDE):"
"MOVE ABCDE TO X(8) RIGHT".
A000-EXIT.
EXIT.
+78
View File
@@ -0,0 +1,78 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. TEST01A.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Project
DATE-WRITTEN. 12 November, 1999.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-ALPHA-FIELDS.
05 WS-ALPHA-1 PIC A(01).
05 WS-ALPHA-2 PIC A(02).
05 WS-ALPHA-3 PIC A(03).
05 WS-ALPHA-4 PIC A(04).
05 WS-ALPHA-5 PIC A(05).
05 WS-ALPHA-6 PIC A(06).
05 WS-ALPHA-7 PIC A(07).
05 WS-ALPHA-26 PIC X(26).
01 WS-ALPHANUM-FIELDS.
05 WS-ALPHANUM-1 PIC X(01).
05 WS-ALPHANUM-2 PIC X(02).
05 WS-ALPHANUM-3 PIC X(03).
05 WS-ALPHANUM-4 PIC X(04).
05 WS-ALPHANUM-5 PIC X(05).
05 WS-ALPHANUM-6 PIC X(06).
01 WS-ALPHA-EDIT-FIELDS.
05 WS-ANE-1 PIC XXBXXX.
05 WS-ANE-2 PIC XBXX.
05 WS-ANE-3 PIC XX/XXX.
05 WS-ANE-4 PIC X/XX.
05 WS-ANE-5 PIC XXBXXBXX.
05 WS-ANE-6 PIC XX/XX/XX.
PROCEDURE DIVISION.
0000-PROGRAM-ENTRY-POINT.
DISPLAY "TEST1-FORMATS program entry."
PERFORM A000-ALPHANUMERIC-TESTS THRU A000-EXIT.
STOP RUN.
A000-ALPHANUMERIC-TESTS.
MOVE "ABCDEFGHIJKLMONPQRSTUVWXYZ"
TO WS-ALPHA-26.
A001-TEST.
MOVE "ABCDE" TO WS-ALPHA-5.
MOVE WS-ALPHA-5 TO WS-ANE-1.
DISPLAY "A010:(" WS-ANE-1 "):(AB CDE):"
"ALPHA SPACE FORMAT TEST MOVE A(5) TO XXBXXX".
MOVE "ABCDE" TO WS-ALPHA-5.
MOVE WS-ALPHA-5 TO WS-ANE-2.
DISPLAY "A011:(" WS-ANE-2 "):(A BC):"
"ALPHA SPACE FORMAT TEST MOVE A(5) TO XBXX".
MOVE "ABCDE" TO WS-ALPHA-5.
MOVE WS-ALPHA-5 TO WS-ANE-5.
DISPLAY "A012:(" WS-ANE-5 "):(AB CD E ):"
"ALPHA MULTI-SPACE FORMAT TEST MOVE A(5) TO XXBXXBXX".
MOVE "ABCDEF" TO WS-ALPHA-6.
MOVE WS-ALPHA-6 TO WS-ANE-5.
DISPLAY "A013:(" WS-ANE-5 "):(AB CD EF):"
"ALPHA MULTI-SPACE FORMAT TEST MOVE A(6) TO XXBXXBXX".
MOVE WS-ALPHA-26 TO WS-ANE-5.
DISPLAY "A014:(" WS-ANE-5 "):(AB CD EF):"
"ALPHA MULTI-SPACE FORMAT TEST MOVE A(26) TO XXBXXBXX".
A000-EXIT.
EXIT.
+77
View File
@@ -0,0 +1,77 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. TEST01B.
AUTHOR. GLEN COLBERT.
INSTALLATION. Tiny Cobol Project
DATE-WRITTEN. 12 November, 1999.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-ALPHA-FIELDS.
05 WS-ALPHA-1 PIC A(01).
05 WS-ALPHA-2 PIC A(02).
05 WS-ALPHA-3 PIC A(03).
05 WS-ALPHA-4 PIC A(04).
05 WS-ALPHA-5 PIC A(05).
05 WS-ALPHA-6 PIC A(06).
05 WS-ALPHA-7 PIC A(07).
05 WS-ALPHA-26 PIC X(26).
01 WS-ALPHANUM-FIELDS.
05 WS-ALPHANUM-1 PIC X(01).
05 WS-ALPHANUM-2 PIC X(02).
05 WS-ALPHANUM-3 PIC X(03).
05 WS-ALPHANUM-4 PIC X(04).
05 WS-ALPHANUM-5 PIC X(05).
05 WS-ALPHANUM-6 PIC X(06).
01 WS-ALPHA-EDIT-FIELDS.
05 WS-ANE-1 PIC XXBXXX.
05 WS-ANE-2 PIC XBXX.
05 WS-ANE-3 PIC XX/XXX.
05 WS-ANE-4 PIC X/XX.
05 WS-ANE-5 PIC XXBXXBXX.
05 WS-ANE-6 PIC XX/XX/XX.
PROCEDURE DIVISION.
0000-PROGRAM-ENTRY-POINT.
DISPLAY "TEST1-FORMATS program entry."
PERFORM A000-ALPHANUMERIC-TESTS THRU A000-EXIT.
STOP RUN.
A000-ALPHANUMERIC-TESTS.
MOVE "ABCDEFGHIJKLMONPQRSTUVWXYZ"
TO WS-ALPHA-26.
A001-TEST.
MOVE "ABCDE" TO WS-ALPHA-5.
MOVE WS-ALPHA-5 TO WS-ANE-3.
DISPLAY "A020:(" WS-ANE-3 "):(AB/CDE):"
"ALPHA SLASH FORMAT TEST MOVE A(5) TO XX/XXX".
MOVE WS-ALPHA-26 TO WS-ANE-3.
DISPLAY "A021:(" WS-ANE-3 "):(AB/CDE):"
"ALPHA SLASH ALIGN FORMAT TEST MOVE A(26) TO XX/XXX".
MOVE "ABCDE" TO WS-ALPHA-5.
MOVE WS-ALPHA-5 TO WS-ANE-4.
DISPLAY "A022:(" WS-ANE-4 "):(A/BC):"
"ALPHA SLASH FORMAT TEST MOVE A(5) TO X/XX".
MOVE "ABCDE" TO WS-ALPHA-5.
MOVE WS-ALPHA-5 TO WS-ANE-6.
DISPLAY "A023:(" WS-ANE-6 "):(AB/CD/E ):"
"ALPHA SLASH FORMAT TEST MOVE A(5) TO XX/XX/XX".
MOVE WS-ALPHA-26 TO WS-ANE-6.
DISPLAY "A023:(" WS-ANE-6 "):(AB/CD/EF):"
"ALPHA SLASH FORMAT TEST MOVE A(25) TO XX/XX/XX".
A000-EXIT.
EXIT.
+79
View File
@@ -0,0 +1,79 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. TEST1_FORMATS.
AUTHOR. JIM NOETH.
INSTALLATION. Tiny Cobol Project
DATE-WRITTEN. 03 January, 2000.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-COMP-VALUE PIC S9(9) COMP.
01 WS-DISPLAY-5 PIC 9(05).
01 WS-DISPLAY-WITH-FRAC PIC 9(05)V9999.
01 WS-DISPLAY-WITH-SIGN PIC S9(07).
01 WS-ANOTHER-COMP PIC 9(04) COMP.
01 WS-PACKED PIC 9(07)V99 COMP-3.
01 WS-EDITED-1 PIC $$$$,$$9-.
01 WS-CHARACTER-SHORT PIC X(08).
01 WS-CHARACTER-LONG PIC X(15).
*
*
01 WS-DUMP-COUNT PIC 9(04).
01 WS-DUMP-OUT-8 PIC X(08).
01 WS-DUMP-OUT-10 PIC X(10).
PROCEDURE DIVISION.
0000-PROGRAM-ENTRY-POINT.
DISPLAY "TEST1_FORMATS.program entry."
PERFORM A000-COMPUTATIONAL-TESTS THRU A000-EXIT.
STOP RUN.
A000-COMPUTATIONAL-TESTS.
A001-TEST.
MOVE "-5432" TO WS-COMP-VALUE.
MOVE WS-COMP-VALUE TO WS-DISPLAY-5.
DISPLAY "A301:(" WS-DISPLAY-5 "):(05432):"
"COMP MOVE -5432 TO 9(05)".
MOVE WS-COMP-VALUE TO WS-DISPLAY-WITH-FRAC.
DISPLAY "A302:(" WS-DISPLAY-WITH-FRAC "):(05432.0000):"
"COMP MOVE -5432 TO 9(05)V9(04)".
MOVE WS-COMP-VALUE TO WS-DISPLAY-WITH-SIGN.
DISPLAY "A303:(" WS-DISPLAY-WITH-SIGN "):(-0005432):"
"COMP MOVE -5432 TO S9(07)".
MOVE WS-COMP-VALUE TO WS-ANOTHER-COMP.
DISPLAY "A304:(" WS-ANOTHER-COMP "):(5432):"
"COMP MOVE -5432 TO 9(04) COMP".
MOVE WS-COMP-VALUE TO WS-PACKED.
DISPLAY "A305:(" WS-PACKED "):(0005432.00):"
"COMP MOVE -5432 TO 9(7)V99 COMP-3".
MOVE WS-COMP-VALUE TO WS-EDITED-1.
DISPLAY "A306:(" WS-EDITED-1 "):( $5,432-):"
"COMP MOVE -5432 TO $$$$,$$9-".
MOVE 97531 TO WS-COMP-VALUE.
MOVE WS-COMP-VALUE TO WS-DISPLAY-WITH-SIGN.
MOVE WS-DISPLAY-WITH-SIGN TO WS-ANOTHER-COMP.
DISPLAY "A307:(" WS-ANOTHER-COMP "):(7531):"
"MOVE 97531 AS S9(07) TO 9(04) COMP".
MOVE "-8642975" TO WS-COMP-VALUE.
MOVE WS-COMP-VALUE TO WS-PACKED.
MOVE WS-PACKED TO WS-ANOTHER-COMP.
DISPLAY "A308:(" WS-ANOTHER-COMP "):(2975):"
"MOVE -8642975 AS 9(07)V9(04) COMP-3 TO 9(04) COMP".
A000-EXIT.
EXIT.
+82
View File
@@ -0,0 +1,82 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. TEST1_FORMATS.
AUTHOR. GLEN COLBERT.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-ALPHA-FIELDS.
05 WS-ALPHA-6 PIC A(06).
05 WS-ALPHA-5 PIC A(05).
05 WS-ALPHA-2 PIC A(02).
01 WS-ALPHANUM-FIELDS.
05 WS-ALPHANUM-1 PIC X(01).
05 WS-ALPHANUM-2 PIC X(02).
05 WS-ALPHANUM-3 PIC X(03).
05 WS-ALPHANUM-4 PIC X(04).
05 WS-ALPHANUM-5 PIC X(05).
05 WS-ALPHANUM-6 PIC X(06).
05 WS-ALPHANUM-36 PIC X(36).
05 WS-AB-5 PIC XXBXXX.
05 WS-AB-3 PIC XBXX.
05 WS-AS-5 PIC XX/XXX.
05 WS-AS-3 PIC X/XX.
01 WS-NUMERIC-FIELDS.
05 WS-DISPLAY-NUM-1 PIC 9.
05 WS-DISPLAY-NUM-4 PIC 9(4).
05 WS-DISPLAY-NUM-V5 PIC 9(3)V99.
PROCEDURE DIVISION.
0000-PROGRAM-ENTRY-POINT.
DISPLAY "TEST02 FORMATS program entry."
PERFORM A000-ALPHANUMERIC-TESTS THRU A000-EXIT.
STOP RUN.
A000-ALPHANUMERIC-TESTS.
MOVE "A" TO WS-ALPHANUM-1.
MOVE "AB" TO WS-ALPHANUM-2.
MOVE "ABC" TO WS-ALPHANUM-3.
MOVE "ABCD" TO WS-ALPHANUM-4.
MOVE "ABCDE" TO WS-ALPHANUM-5.
MOVE "ABCDEFGHIJKLMNOPQRSTUVWZYZ0123456789" TO
WS-ALPHANUM-36.
AN01-TEST.
MOVE WS-ALPHANUM-5 TO WS-ALPHANUM-6.
DISPLAY "AN01:(" WS-ALPHANUM-6 "):(ABCDE ):"
"ALPHANUMERIC MOVE TEST MOVE X(5) TO X(6)".
MOVE WS-ALPHANUM-5 TO WS-ALPHA-5.
DISPLAY "AN02:(" WS-ALPHA-5 "):(ABCDE):"
"ALPHANUMERIC MOVE TEST MOVE X(5) TO A(5)".
MOVE WS-ALPHANUM-5 TO WS-ALPHANUM-4.
DISPLAY "AN03:(" WS-ALPHANUM-4 "):(ABCD):"
"ALPHANUMERIC MOVE TEST MOVE X(5) TO X(4)".
MOVE WS-ALPHANUM-5 TO WS-AB-5.
DISPLAY "AB01:(" WS-AB-5 "):(AB CDE):"
"MOVE TEST MOVE X(5) TO XXBXXX".
MOVE WS-ALPHANUM-5 TO WS-AB-3.
DISPLAY "AB02:(" WS-AB-3 "):(A BC):"
"MOVE TEST MOVE X(5) TO XBXX".
MOVE WS-ALPHANUM-5 TO WS-AS-5.
DISPLAY "AS01:(" WS-AS-5 "):(AB/CDE):"
"MOVE TEST MOVE X(5) TO XX/XXX".
MOVE WS-ALPHANUM-5 TO WS-AS-3.
DISPLAY "AS02:(" WS-AS-3 "):(A/BC):"
"MOVE TEST MOVE X(5) TO X/XX".
A000-EXIT.
EXIT.
+132
View File
@@ -0,0 +1,132 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. TEST1_FORMATS.
AUTHOR. GLEN COLBERT.
ENVIRONMENT DIVISION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-ALPHA-FIELDS.
05 WS-ALPHA-6 PIC A(06).
05 WS-ALPHA-5 PIC A(05).
05 WS-ALPHA-2 PIC A(02).
01 WS-ALPHANUM-FIELDS.
05 WS-ALPHANUM-2 PIC X(02).
05 WS-ALPHANUM-4 PIC X(04).
05 WS-ALPHANUM-6 PIC X(06).
05 WS-AB-5 PIC XXBXXX.
05 WS-AB-3 PIC XBXX.
05 WS-AS-5 PIC XX/XXX.
05 WS-AS-3 PIC X/XX.
01 WS-NUMERIC-FIELDS.
05 WS-DISPLAY-NUM-1 PIC 9.
05 WS-DISPLAY-NUM-4 PIC 9(4).
05 WS-DISPLAY-NUM-V5 PIC 9(3)V99.
05 WS-DISPLAY-NUM-R5 REDEFINES WS-DISPLAY-NUM-V5 PIC X(5).
01 WS-NUMERIC-EDITED-FIELDS.
05 WS-NE-1 PIC 99.99.
05 WS-NE-2 PIC 9,999.
05 WS-NE-3 PIC 9,999.99.
05 WS-NE-4 PIC $$$9.
PROCEDURE DIVISION.
0000-PROGRAM-ENTRY-POINT.
DISPLAY "TEST02b FORMATS program entry."
PERFORM A000-ALPHANUMERIC-TESTS THRU A000-EXIT.
STOP RUN.
A000-ALPHANUMERIC-TESTS.
MOVE "23" TO WS-ALPHANUM-2.
MOVE "1984" TO WS-ALPHANUM-4.
MOVE "1965" TO WS-ALPHANUM-6.
AA01-TEST.
MOVE WS-ALPHANUM-4 TO WS-DISPLAY-NUM-4.
DISPLAY "AA01:(" WS-DISPLAY-NUM-4 "):(1984):"
"ALPHANUMERIC MOVE TEST MOVE X(4) TO 9(4)".
MOVE WS-ALPHANUM-4 TO WS-NE-1.
DISPLAY "AA02:(" WS-NE-1 "):(84.00):"
"ALPHANUMERIC MOVE TEST MOVE X(4) TO 99.99".
MOVE WS-ALPHANUM-4 TO WS-NE-2.
DISPLAY "AA03:(" WS-NE-2 "):(1,984):"
"ALPHANUMERIC MOVE TEST MOVE X(4) TO 9,999".
MOVE WS-ALPHANUM-4 TO WS-NE-3.
DISPLAY "AA04:(" WS-NE-3 "):(1,984.00):"
"ALPHANUMERIC MOVE TEST MOVE X(4) TO 9,999.99".
MOVE WS-ALPHANUM-4 TO WS-NE-4.
DISPLAY "AA05:(" WS-NE-4 "):($984):"
"ALPHANUMERIC MOVE TEST MOVE X(4) TO $$$9".
MOVE WS-ALPHANUM-4 TO WS-DISPLAY-NUM-V5.
DISPLAY "AA06:(" WS-DISPLAY-NUM-R5 "):(98400):"
"ALPHANUMERIC MOVE TEST MOVE X(4) TO 9(3)V99".
MOVE WS-ALPHANUM-2 TO WS-DISPLAY-NUM-4.
DISPLAY "AA10:(" WS-DISPLAY-NUM-4 "):(0023):"
"ALPHANUMERIC MOVE TEST MOVE X(2) TO 9(4)".
MOVE WS-ALPHANUM-2 TO WS-NE-1.
DISPLAY "AA11:(" WS-NE-1 "):(23.00):"
"ALPHANUMERIC MOVE TEST MOVE X(2) TO 99.99".
MOVE WS-ALPHANUM-2 TO WS-NE-2.
DISPLAY "AA12:(" WS-NE-2 "):(0,023):"
"ALPHANUMERIC MOVE TEST MOVE X(2) TO 9,999".
MOVE WS-ALPHANUM-2 TO WS-NE-3.
DISPLAY "AA13:(" WS-NE-3 "):(0,023.00):"
"ALPHANUMERIC MOVE TEST MOVE X(2) TO 9,999.99".
MOVE WS-ALPHANUM-2 TO WS-NE-4.
DISPLAY "AA14:(" WS-NE-4 "):( $23):"
"ALPHANUMERIC MOVE TEST MOVE X(2) TO $$$9".
MOVE WS-ALPHANUM-2 TO WS-DISPLAY-NUM-V5.
DISPLAY "AA15:(" WS-DISPLAY-NUM-R5 "):(02300):"
"ALPHANUMERIC MOVE TEST MOVE X(2) TO 9(3)V99".
MOVE WS-ALPHANUM-6 TO WS-DISPLAY-NUM-4.
DISPLAY "AA01:(" WS-DISPLAY-NUM-4 "):(1965):"
"ALPHANUMERIC MOVE TEST MOVE X(6) TO 9(4)".
MOVE WS-ALPHANUM-6 TO WS-NE-1.
DISPLAY "AA02:(" WS-NE-1 "):(65.00):"
"ALPHANUMERIC MOVE TEST MOVE X(6) TO 99.99".
MOVE WS-ALPHANUM-6 TO WS-NE-2.
DISPLAY "AA03:(" WS-NE-2 "):(1,965):"
"ALPHANUMERIC MOVE TEST MOVE X(6) TO 9,999".
MOVE WS-ALPHANUM-6 TO WS-NE-3.
DISPLAY "AA04:(" WS-NE-3 "):(1,965.00):"
"ALPHANUMERIC MOVE TEST MOVE X(6) TO 9,999.99".
MOVE WS-ALPHANUM-6 TO WS-NE-4.
DISPLAY "AA05:(" WS-NE-4 "):($965):"
"ALPHANUMERIC MOVE TEST MOVE X(6) TO $$$9".
MOVE WS-ALPHANUM-6 TO WS-DISPLAY-NUM-V5.
DISPLAY "AA06:(" WS-DISPLAY-NUM-R5 "):(96500):"
"ALPHANUMERIC MOVE TEST MOVE X(6) TO 9(3)V99".
MOVE WS-ALPHANUM-2 TO WS-AB-5.
DISPLAY "AB01:(" WS-AB-5 "):(23 ):"
"ALPHANUMERIC MOVE TEST MOVE X(2) TO XXBXXX".
A000-EXIT.
EXIT.
+118
View File
@@ -0,0 +1,118 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. TEST3_FORMATS.
AUTHOR. GLEN COLBERT.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
* INPUT-OUTPUT SECTION.
* FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WS-ALPHANUM-FIELDS.
05 WS-ALPHANUM-1 PIC X(01).
05 WS-ALPHANUM-2 PIC X(02).
05 WS-ALPHANUM-3 PIC X(03).
05 WS-ALPHANUM-4 PIC X(04).
05 WS-ALPHANUM-5 PIC X(05).
05 WS-ALPHANUM-6 PIC X(06).
05 WS-ALPHANUM-7 PIC X(07).
05 WS-AB-5 PIC XXBXXX.
05 WS-AB-3 PIC XBXX.
01 WS-NUMERIC-FIELDS.
05 WS-DISPLAY-NUM-1 PIC 9.
05 WS-DISPLAY-NUM-2 PIC 9(2).
05 WS-DISPLAY-NUM-3 PIC 9(3).
05 WS-DISPLAY-NUM-4 PIC 9(4).
05 WS-DISPLAY-NUM-5 PIC 9(5).
05 WS-DISPLAY-NUM-6 PIC 9(6).
05 WS-DISPLAY-NUM-7 PIC 9(7).
05 WS-DISPLAY-NUM-V5 PIC 9(3)V99.
05 WS-DISPLAY-NUM-R5 REDEFINES WS-DISPLAY-NUM-V5
PIC X(5).
PROCEDURE DIVISION.
0000-PROGRAM-ENTRY-POINT.
DISPLAY "TEST02 FORMATS program entry."
PERFORM A000-ALPHANUMERIC-TESTS THRU A000-EXIT.
STOP RUN.
A000-ALPHANUMERIC-TESTS.
AN01-TEST.
MOVE 9 TO WS-DISPLAY-NUM-1.
MOVE 89 TO WS-DISPLAY-NUM-2.
MOVE 789 TO WS-DISPLAY-NUM-3.
MOVE 6789 TO WS-DISPLAY-NUM-4.
MOVE 56789 TO WS-DISPLAY-NUM-5.
MOVE 456789 TO WS-DISPLAY-NUM-6.
MOVE 3456789 TO WS-DISPLAY-NUM-7.
MOVE WS-DISPLAY-NUM-1 TO WS-ALPHANUM-6.
DISPLAY "AN01:(" WS-ALPHANUM-6 "):(9 ):"
"LEFT ALIGNMENT MOVE TEST MOVE 9(1) TO X(6)".
MOVE WS-DISPLAY-NUM-4 TO WS-ALPHANUM-6.
DISPLAY "AN02:(" WS-ALPHANUM-6 "):(6789 ):"
"LEFT ALIGNMENT MOVE TEST MOVE 9(4) TO X(6)".
MOVE WS-DISPLAY-NUM-6 TO WS-ALPHANUM-6.
DISPLAY "AN03:(" WS-ALPHANUM-6 "):(456789):"
"LEFT ALIGNMENT MOVE TEST MOVE 9(6) TO X(6)".
MOVE WS-DISPLAY-NUM-7 TO WS-ALPHANUM-6.
DISPLAY "AN04:(" WS-ALPHANUM-6 "):(345678):"
"LEFT ALIGNMENT MOVE TEST MOVE 9(7) TO X(6)".
MOVE WS-DISPLAY-NUM-5 TO WS-DISPLAY-NUM-7
DISPLAY "AN05:(" WS-DISPLAY-NUM-7 "):(0056789):"
"RIGHT ALIGNMENT MOVE TEST MOVE 9(5) TO 9(7)".
MOVE WS-DISPLAY-NUM-5 TO WS-DISPLAY-NUM-2
DISPLAY "AN06:(" WS-DISPLAY-NUM-2 "):(89):"
"RIGHT ALIGNMENT MOVE TEST MOVE 9(5) TO 9(2)".
MOVE WS-DISPLAY-NUM-5 TO WS-DISPLAY-NUM-1
DISPLAY "AN07:(" WS-DISPLAY-NUM-1 "):(9):"
"RIGHT ALIGNMENT MOVE TEST MOVE 9(5) TO 9(1)".
MOVE WS-DISPLAY-NUM-5 TO WS-DISPLAY-NUM-V5
DISPLAY "AN08:(" WS-DISPLAY-NUM-R5 "):(78900):"
"RIGHT ALIGNMENT MOVE TEST MOVE 9(5) TO 9(3)V99".
MOVE 12345 TO WS-DISPLAY-NUM-5.
MOVE WS-DISPLAY-NUM-5 TO WS-ALPHANUM-2.
DISPLAY "AN22:(" WS-ALPHANUM-2 "):(12):"
"MOVE TEST MOVE 9(5) TO X(2)".
MOVE 12345 TO WS-DISPLAY-NUM-5.
MOVE WS-DISPLAY-NUM-5 TO WS-ALPHANUM-6.
DISPLAY "AN23:(" WS-ALPHANUM-6 "):(12345 ):"
"MOVE TEST MOVE 9(5) TO X(6)".
MOVE 0 TO WS-DISPLAY-NUM-4.
DISPLAY "AC01:(" WS-DISPLAY-NUM-4 "):(0000):"
"CONSTANT MOVE TEST MOVE 0 TO 9(4)".
MOVE ".02" TO WS-DISPLAY-NUM-4.
DISPLAY "AC02:(" WS-DISPLAY-NUM-4 "):(0000):"
"CONSTANT MOVE TEST MOVE .02 TO 9(4)".
MOVE 2 TO WS-DISPLAY-NUM-4.
DISPLAY "AC03:(" WS-DISPLAY-NUM-4 "):(0002):"
"CONSTANT MOVE TEST MOVE 2 TO 9(4)".
MOVE "1234.5" TO WS-DISPLAY-NUM-4.
DISPLAY "AC04:(" WS-DISPLAY-NUM-4 "):(1234):"
"CONSTANT MOVE TEST MOVE 1234.5 TO 9(4)".
MOVE "-123.4" TO WS-DISPLAY-NUM-4.
DISPLAY "AC05:(" WS-DISPLAY-NUM-4 "):(0123):"
"CONSTANT MOVE TEST MOVE -123.4 TO 9(4)".
A000-EXIT.
EXIT.

Some files were not shown because too many files have changed in this diff Show More